home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / FADSSR / FADS.PAS next >
Encoding:
Pascal/Delphi Source File  |  1995-03-28  |  80.9 KB  |  2,204 lines

  1. { FADS: Find - Attributes - DateTime - Size }
  2. { Compile with Borland Pascal 7.0
  3.   no compiler directives required. }
  4.  
  5. USES DOS, CRT;
  6.  
  7. CONST Version = '1.1';
  8.       Extra = '(Freeware by Al)';
  9.  
  10.       { This is the main constant limiting the expandability of the program }
  11.       MaxDirs = 3072;
  12.  
  13.       { Length of string needed to hold file information string
  14.         (minimum size : Max. Length of a Directory }
  15.       LenInfoStr = 90;
  16.  
  17.       { assume 25-row screen (for now) }
  18.       MaxRows = 25;
  19.  
  20.       { Chameleon constants }
  21.       ProgFD = 1; { FileDate }
  22.       ProgLD = 2; { ListDirs }
  23.       ProgFF = 3; { FindFile }
  24.       ProgFA = 4; { FindAttr }
  25.       ProgLC = 5; { LineCounter }
  26.       MaxProg  = 5;
  27.       MaxNames = 3;
  28.       ProgNameArray : ARRAY[ 1..MaxProg, 1..MaxNames ] OF NameStr =
  29.                       ( ( 'FD', 'FILEDATE', 'TOUCH' ),
  30.                         ( 'LD', 'LISTDIR', '' ),
  31.                         ( 'FF', 'FILEFIND', 'FINDFILE' ),
  32.                         ( 'FA', 'FILEATTR', '' ),
  33.                         ( 'LC', 'COUNTLNS', '' ) );
  34.  
  35.       { Used by FF & FA for attribute handling }
  36.       AttrSys = #1; { Handled in ChkFlag }
  37.       AttrChar : ARRAY[ 1..4 ] OF CHAR = ( 'R', 'A', AttrSys, 'H' );
  38.       AttrVal : ARRAY[ 1..4 ] OF BYTE = ( ReadOnly, Archive, SysFile, Hidden ); {BP constants}
  39.  
  40.       { Cmd.. & Val.. for Touch }
  41.       CmdValNone = 0;      { No /D or /T switch on command line }
  42.       CmdValFlagOnly = -1; { /D or /T, but without a specified date/time }
  43.       CmdValArg = 1;       { /D or /T with a specified date/time }
  44.       ValFile = 0;  { retain date OR time from file itself }
  45.       ValSys  = 1;  { use system date OR time for new value }
  46.       ValArg  = 2;  { use specified argument date OR time for new value }
  47.  
  48.       { for multiple filespecs passed to FF or COUNTLNS
  49.         - undocumented except here.
  50.         Note: path is retrieved from first non-flag parameter only }
  51.       MaxSpecs = 10; { should be plenty }
  52.  
  53.       { repeated strings }
  54.       UserBreak = 'User Break';
  55.       Proceed   = 'Proceed (Y/N) -> ';
  56.       NullStr   = '';
  57.  
  58.       { for cluster size scenario }
  59.       MaxClustChk = 5; { will be used as 1K * 2 ^ MaxClustChk }
  60.  
  61.       { for output options }
  62.       MaxOutOpts = 7; { Note: Code is dependent on this being a SINGLE digit }
  63.  
  64.       { busy symbols }
  65.       Busy : ARRAY[ 1..4 ] OF CHAR = ( '/', '─', '\', '|' );
  66.  
  67. TYPE Str2  = STRING[ 2 ];
  68.      Str3  = STRING[ 3 ];
  69.      Str4  = STRING[ 4 ];
  70.      Str8  = STRING[ 8 ];
  71.      Str12 = STRING[ 12 ];
  72.      Str16 = STRING[ 16 ];
  73.      Str20 = STRING[ 20 ];
  74.      InfoStr = STRING[ LenInfoStr ];
  75.  
  76.      PathRec = RECORD { our doggone favorite record type }
  77.                  P : InfoStr;
  78.                  TF : BOOLEAN;
  79.                END; { RECORD PathRec }
  80.      PathRecPtr = ^PathRec; { a pointer to our doggone favorite record type }
  81.      IndexArray = ARRAY[ 1..MaxDirs ] OF PathRecPtr; { a whole bunch of pointers, yippee! }
  82.  
  83. (* @@ Scrn - 4K too much memory to give up
  84.      ScrnRec1 = RECORD
  85.        SB : ARRAY[ 1..25 , 1..80, 0..1 ] OF BYTE;
  86.        Y, X : BYTE;
  87.        VideoMem : WORD;
  88.      END; { RECORD ScrnRec1 }
  89. *)
  90.  
  91. VAR ArgDT     : DateTime;    { Command Line argument DateTime record }
  92.     AttrFlag  : ARRAY[ 1..4 ]
  93.                 OF SHORTINT; { Flags to tell FF/FA to look for/set att's }
  94.     AutoYesTF : BOOLEAN;     { Automatically answer Yes to prompt T/F }
  95.     BlankLine : STRING;      { 79 spaces, do you care? }
  96.     Capacity  : LongInt;     { Size of disk }
  97.     CD        : DirStr;      { current directory at start }
  98.     ClusterTF : BOOLEAN;     { show "cluster size scenario" }
  99.     Clusticity : ARRAY[ 1..2 ]
  100.                  OF LONGINT; { Cluster size of ( 2 ) disks }
  101.     CmdLine   : STRING;      { Command line entered by user }
  102.     CodeDate, CodeTime : SHORTINT; { Flags (a) check parameters on start; (b) setting file Date/Time }
  103.     CountLnsTF : BOOLEAN;    { count lines instead of cluster-space }
  104.     DirTotal  : WORD;        { # of directories involved /S }
  105.     DrvSource : CHAR;        { Source drive (from dir #1)- FF }
  106.     DrvTarget : CHAR;        { Target drive - FF }
  107.     EnvVar    : STRING;      { alt. sets of directories to scan }
  108.     ExitDirNum : WORD;       { # of directory to exit to - FF }
  109.     FileTotal : WORD;        { # of files (and directories) involved (FF only }
  110.     ForcePromptTF : BOOLEAN; { Force prompting of user even if only one file }
  111.     FW        : TEXT;        { File handle for OutputFile, if used }
  112.     Index     : IndexArray;  { for storing list of directories /S }
  113.     LinesTotal : LONGINT;    { Total # of lines counted if CountLnsTF set }
  114.     NumFiles  : WORD;        { # of files to touch }
  115.     ProgramName : NameStr;   { Name of Program }
  116.     ProgramNum : BYTE;       { Number of Program: Progxx above }
  117.     PS        : PathStr;     { command line filespec }
  118.     PSadd : ARRAY[ 1..MaxSpecs ]
  119.             OF Str12; { additional filespec for FF & LC }
  120.     PSaddCount : BYTE;          { # of additional filespecs }
  121.     OutputFile : PathStr;    { output file ( valid only for FF, LD, LC ) }
  122.     OutFlag : ARRAY[ 1..MaxOutOpts ]
  123.               OF BOOLEAN;    {/W1 - include command line echo
  124.                                 2 - include # of directories
  125.                                 3 - include directory name w/o number
  126.                                 4 - include directory name with #.
  127.                                 5 - include file listing
  128.                                 6 - include # of files found
  129.                                 7 - include bytes summary info
  130.                                 default : ALL
  131.                                 3 & 4 are mutually exclusive ( 4 overrides ) }
  132.     OutOverAutoTF : BOOLEAN; { automatic overwrite Output file (no prompt) }
  133.     OutputTF : BOOLEAN;      { Flag to signal Output File }
  134. (* @@ Scrn
  135.     Scrn     : ScrnRec1;     { saved screen - 4KB }
  136. *)
  137.     SpaceCluster : ARRAY[ 1..MaxClustChk, 1..2 ]
  138.                    OF LONGINT; { 1 - total size of files ( ,1 )
  139.                                      and tree structure ( ,2 )
  140.                                      using smallest HD cluster of 2K
  141.                                      ( up to 128 MB partition )
  142.                                  2 - same using 4K ( up to 256 MB )
  143.                                  3 - same using 8K ( up to 512 MB )
  144.                                  4 - same using 16K ( up to 1GB )
  145.                                  5 - same using 32K ( up to 2GB ) }
  146.     SpaceTotal : ARRAY[ 0..2 ]
  147.                  OF LONGINT; { 0 - total size of files
  148.                                1 - total space of files on source
  149.                                2 - total space of files on source
  150.                                    including dir structure }
  151.     SubDirTF  : BOOLEAN;     { Include subdirectories T/F }
  152.     SysDT     : DateTime;    { System clock's DateTime record }
  153.     TargetSize : ARRAY[ 1..2 ]
  154.                  OF LONGINT; { 1 = space available (free) on target
  155.                                2 = size of target disk }
  156.     TargetSpace : ARRAY[ 1..2 ]
  157.                   OF LONGINT; { 1 = total space req'd on target
  158.                                     (files only - no directories)
  159.                                 2 = total space req'd on target
  160.                                     including dir structure }
  161.     UserDateStr : STRING;    { string to present to user at confirmation prompt }
  162.     UserTimeStr : STRING;    { string to present to user at confirmation prompt }
  163.     YY          : BYTE;      { Screen Y for output }
  164.     ZipScanTF   : BOOLEAN;   { Scan ZIP files when FF'ing a file }
  165.  
  166. {
  167. ╔══════════════════════════════════════════════════════════════════════════╗
  168. ║ General purpose functions used by FADS.Pas                               ║
  169. ╚══════════════════════════════════════════════════════════════════════════╝
  170. }
  171.  
  172. { general function: returns larger of two numbers }
  173. FUNCTION Max( W1, W2 : WORD ) : WORD;
  174. BEGIN
  175.   IF ( W1 > W2 ) THEN Max := W1 ELSE Max := W2;
  176. END; { Max }
  177.  
  178. { general function: returns smaller of two numbers }
  179. FUNCTION Min( W1, W2 : WORD ) : WORD;
  180. BEGIN
  181.   IF ( W1 < W2 ) THEN Min := W1 ELSE Min := W2;
  182. END; { Min }
  183.  
  184. { general function: returns position of last character Ch in String }
  185. FUNCTION LastPos( Ch : CHAR; S : STRING ) : BYTE;
  186. VAR I : BYTE;
  187. BEGIN
  188.   FOR I := LENGTH( S ) DOWNTO 1 DO IF ( S[ I ] = Ch ) THEN BEGIN
  189.     LastPos := I;
  190.     EXIT;
  191.   END;
  192.   LastPos := 0;
  193. END; { LastPos }
  194.  
  195. { general function: returns upper case version of String }
  196. FUNCTION UpStr( AA : STRING ) : STRING;
  197. VAR I : BYTE;
  198. BEGIN
  199.   FOR I := 1 TO LENGTH( AA ) DO AA[ I ] := UpCase( AA[ I ] );
  200.   UpStr := AA;
  201. END; { UpStr }
  202.  
  203. { general function: returns string with zeroes substituted for spaces }
  204. FUNCTION Zero( A0 : Str12 ) : Str12;
  205. VAR ZI : BYTE;
  206. BEGIN
  207.   FOR ZI := 1 TO 2 DO IF ( A0[ ZI ] = #32 ) THEN A0[ ZI ] := '0';
  208.   Zero := A0;
  209. END; { Zero }
  210.  
  211. { general function: formatted date or time string }
  212. FUNCTION DateTimeStr( W1, W2, W3 : WORD ) : Str12;
  213. VAR Ch : CHAR;
  214.     S1, S2, S3 : Str12;
  215.     L : BYTE;
  216. BEGIN
  217.   STR( W1 : 2, S1 );
  218.   STR( W2 : 2, S2 );
  219.   IF ( W3 > 59 ) THEN BEGIN  { assume date string if W3 is greater than 59 }
  220.     L := 4;
  221.     Ch := '-';
  222.   END ELSE BEGIN
  223.     L := 2;
  224.     Ch := ':';
  225.   END;
  226.   STR( W3 : L, S3 );
  227.   DateTimeStr := Zero( S1 ) + Ch + Zero( S2 ) + Ch + Zero( S3 );
  228. END; { DateTimeStr }
  229.  
  230. { general function: returns String with leading & trailing spaces removed }
  231. FUNCTION Trim( AA : STRING ) : STRING;
  232. VAR I : BYTE;
  233. BEGIN
  234.   WHILE ( COPY( AA, 1, 1 ) = ' ') DO AA := COPY( AA, 2, 255 );
  235.   WHILE ( COPY( AA, LENGTH( AA ), 1 ) = ' ')
  236.     DO AA := COPY( AA, 1, LENGTH( AA ) - 1 );
  237.   Trim := AA;
  238. END; { Trim }
  239.  
  240. { general function: produces String of char(s) AA of RJ * LEN(AA) length }
  241. FUNCTION Replicate( AA : STRING; RJ : BYTE ) : STRING;
  242. VAR RR : STRING;
  243.     RI : BYTE;
  244. BEGIN
  245.   RR := '';
  246.   FOR RI := 1 TO RJ DO RR := RR + COPY( AA, 1, 1 );
  247.   Replicate := RR;
  248. END; { Replicate }
  249.  
  250. { general function: returns String padded with char Ch to length L
  251.                     if LeftPadTF (spaces added to left side);
  252.                     default: add spaces to right }
  253. FUNCTION PadChar( AAA : STRING; L : BYTE; Ch : CHAR; LeftPadTF : BOOLEAN )
  254.          : STRING;
  255. BEGIN
  256.   IF ( LENGTH( AAA ) < L ) THEN BEGIN
  257.     IF LeftPadTF THEN PadChar := Replicate( Ch, L - LENGTH( AAA ) ) + AAA
  258.                  ELSE PadChar := AAA + Replicate( Ch, L - LENGTH( AAA ) );
  259.   END ELSE PadChar := COPY( AAA, 1, L );
  260. END; { PadChar }
  261.  
  262. { general function: returns String padded with spaces on left to length L }
  263. FUNCTION PadL( AAA : STRING; L : BYTE ) : STRING;
  264. BEGIN
  265.   PadL := PadChar( AAA, L, #32, TRUE );
  266. END; { PadL }
  267.  
  268. { general function: returns String padded with spaces on right to length L }
  269. FUNCTION PadR( AAA : STRING; L : BYTE ) : STRING;
  270. BEGIN
  271.   PadR := PadChar( AAA, L, #32, FALSE );
  272. END; { PadR }
  273.  
  274. { general function: returns filename (incl. wildcard) as a 12-character
  275.                     string with "?" in "wild" positions }
  276. FUNCTION File12( M : Str12 ) : Str12;
  277. VAR MM : Str12;
  278.     MI : BYTE;
  279.     MP : BOOLEAN;
  280. BEGIN
  281.   MM := '';
  282.   MP := FALSE;
  283.   FOR MI := 1 TO LENGTH( M ) DO CASE M[ MI ] OF
  284.     '*' : IF MP THEN MM := MM + REPLICATE( '?', 12 - LENGTH( MM ) )
  285.                 ELSE MM := MM + REPLICATE( '?', 8 - LENGTH( MM ) );
  286.     '.' : BEGIN
  287.           MM := PadR( MM, 8 ) + '.';
  288.           MP := TRUE;
  289.           END;
  290.     ELSE MM := MM + UpCase( M[ MI ] );
  291.     END; { CASE MI }
  292.   File12 := PadR( MM, 12 );
  293. END; { File12 }
  294.  
  295. { general function: tests the first filename S1 against the template S2
  296.                     Note: Order of S1 & S2 significant }
  297. FUNCTION Match( S1, S2 : Str12 ) : BOOLEAN;
  298. VAR M : BOOLEAN;
  299.     MM : BYTE;
  300. BEGIN
  301.   M := TRUE;
  302.   FOR MM := 1 TO 12 DO IF ( ( S1[ MM ] <> S2[ MM ] ) AND ( S2[ MM ] <> '?' ) )
  303.       THEN M := FALSE;
  304.   Match := M;
  305. END;
  306.  
  307. { general function: add a filename/directory to a path }
  308. FUNCTION FullName(Dir : DirStr; Fname : Str12) : PathStr;
  309. BEGIN
  310. IF ( Dir[ LENGTH( Dir ) ] = '\' ) THEN FullName := Dir + Fname
  311.                                   ELSE FullName := Dir + '\' + Fname;
  312. END; { FullName }
  313.  
  314. { general function: returns String with commas inserted }
  315. FUNCTION PrintUsing( N : LONGINT ) : Str20;
  316. VAR S1, S2 : Str12;
  317. BEGIN
  318.   IF ( N = 0 ) THEN PrintUsing := '0' ELSE BEGIN
  319.     STR( N : TRUNC( LN( N ) / LN( 10 ) ) + 1, S1 );
  320.     S2 := '';
  321.     WHILE ( LENGTH( S1 ) > 3 ) DO BEGIN
  322.       S2 := COPY( S1, LENGTH( S1 ) - 2, 3 ) + S2;
  323.       S1 := COPY( S1, 1, LENGTH( S1 ) - 3 );
  324.       S2 := ',' + S2;
  325.       END;
  326.     PrintUsing := S1 + S2;
  327.     END;
  328. END; { PrintUsing }
  329.  
  330. { general function: returns # of bytes in a cluster on a disk }
  331. { DrvNo : 0 = default drive; 1 = A, 2 = B, ... (just like BP7's DiskSize ) }
  332. FUNCTION ByteClust( DrvNo : BYTE ) : WORD;
  333. VAR BCregs : Registers;
  334.     BC     : LongInt;
  335. BEGIN
  336.   BCregs.AX := $3600;
  337.   BCregs.DX := DrvNo;
  338.   MsDos( BCregs );
  339.   BC := BCregs.AL * BCregs.CX;
  340.   ByteClust := BC;
  341. END; { ByteClust }
  342.  
  343. { general function: returns lowest multiple of ClustSize >= ActualSize }
  344. FUNCTION ByteAdjust( ActualSize, ClustSize : LongInt ) : LongInt;
  345. VAR BAret : REAL;
  346.     BAint : REAL;
  347. BEGIN
  348.   IF ( ClustSize = 0 ) THEN BAret := 0 ELSE BEGIN
  349.     BAint := INT( ActualSize / ClustSize );
  350.     BAret := BAint * ClustSize;
  351.     IF ( BAret <> ActualSize ) THEN BAret := BAret + ClustSize;
  352.   END;
  353.   ByteAdjust := ROUND( BAret );
  354. END; { ByteAdjust }
  355.  
  356. { general function: returns % of SpaceUsed not use for FileContents }
  357. FUNCTION WastedSpace( ActualSize, SpaceUsed : LongInt ) : Str12;
  358. VAR BA : REAL;
  359.     S12 : Str12;
  360. BEGIN
  361.   BA := ( ( SpaceUsed - ActualSize ) / SpaceUsed ) * 100;
  362.   STR( BA : 3 : 2, S12 );
  363.   WastedSpace := S12;
  364. END; { WastedSpace }
  365.  
  366. { general function: returns number raised to a power }
  367. FUNCTION Power( Number : LongInt; Exponent : BYTE ) : LongInt;
  368. VAR I : BYTE;
  369.     Ret : LONGINT;
  370. BEGIN
  371.   Ret := 1;
  372.   FOR I := 1 TO Exponent DO Ret := Ret * Number;
  373.   Power := Ret;
  374. END; { Power }
  375.  
  376. { general function: returns attribute value as a string of 4 chars in the
  377.                     form RASH, using a "." if a specific attribute is not
  378.                     set }
  379. FUNCTION AttributeStr( Attr : BYTE ) : Str12;
  380. VAR AttrStr : Str12;
  381. BEGIN
  382.   AttrStr := '';
  383.   IF ( Attr AND ReadOnly = ReadOnly )
  384.     THEN AttrStr := AttrStr + 'r'
  385.     ELSE AttrStr := AttrStr + '.';
  386.   IF ( Attr AND Archive = Archive )
  387.     THEN AttrStr := AttrStr + 'a'
  388.     ELSE AttrStr := AttrStr + '.';
  389.   IF ( Attr AND SysFile = SysFile )
  390.     THEN AttrStr := AttrStr + 's'
  391.     ELSE AttrStr := AttrStr + '.';
  392.   IF ( Attr AND Hidden = Hidden )
  393.     THEN AttrStr := AttrStr + 'h'
  394.     ELSE AttrStr := AttrStr + '.';
  395.   AttributeStr := AttrStr;
  396. END; { AttributeStr }
  397.  
  398. (* @@ Scrn
  399.   { general function: save current screen to Scrn variable }
  400.   PROCEDURE ScrGet1;
  401.   VAR I, J, K : BYTE;
  402.       Reg : Registers;
  403.   BEGIN
  404.     IF ( Mem[ $40 : $63 ] = $B4 ) THEN Scrn.VideoMem := $B000 {monochrome}
  405.                                   ELSE Scrn.VideoMem := $B800; {color}
  406.     FOR I:= 1 TO 25 DO FOR J := 1 TO 80 DO FOR K := 0 TO 1 DO
  407.     Scrn.SB[ I, J, K ] :=
  408.              MEM[ Scrn.VideoMem : ( I - 1 ) * 160 + ( J - 1 ) * 2 + K ];
  409.     Scrn.Y := WHEREY;
  410.     Scrn.X := WHEREX;
  411.   END; { ScrGet1 }
  412.  
  413.   { general function: restore saved screen from Scrn variable }
  414.   PROCEDURE ScrPut1( CursorBack : BOOLEAN );
  415.   VAR I, J, K : BYTE;
  416.   BEGIN
  417.     FOR I := 1 TO 25 DO FOR J := 1 TO 80 DO FOR K := 0 TO 1 DO
  418.       MEM[ Scrn.VideoMem : ( I - 1 ) * 160 + ( J - 1 ) * 2 + K ] :=
  419.       Scrn.SB[ I, J, K ];
  420.     IF CursorBack THEN GOTOXY( Scrn.X, Scrn.Y );
  421.   END; { ScrPut1 }
  422. *)
  423.  
  424. { general function: check for ESC or ^C by user
  425.                     Confirm Quit if ESC
  426.                     Note: Uses global CD (current dir) & UserBreak var }
  427. PROCEDURE UserEscQuit;
  428. CONST QuitStr = '   Quit now? ( Y / N ) -> ';
  429. VAR Ch : CHAR;
  430.     YY, XX : BYTE;
  431. BEGIN
  432.   IF KeyPressed THEN BEGIN
  433.     Ch := READKEY;
  434.     IF ( Ch = #27 ) THEN BEGIN
  435.       YY := WHEREY;
  436.       XX := WHEREX;
  437.       Write( QuitStr );
  438.       REPEAT
  439.         Ch := UpCase( READKEY );
  440.       UNTIL ( Ch IN [ 'Y', 'N', #27, #32 ] );
  441.       GOTOXY( XX, YY );
  442.       Write( Replicate( #32, LENGTH( QuitStr ) ) );
  443.       GOTOXY( XX, YY );
  444.       IF ( Ch = 'Y' ) THEN Ch := #3;
  445.     END;
  446.     IF ( Ch = #3 ) THEN BEGIN
  447.       WriteLn;
  448.       WriteLn( UserBreak );
  449.       ChDir( CD );
  450.       HALT;
  451.     END;
  452.   END;  { Keypressed }
  453. END;    { UserEscQuit }
  454.  
  455. {
  456. ╔══════════════════════════════════════════════════════════════════════════╗
  457. ║ Error & Help messages                                                    ║
  458. ╚══════════════════════════════════════════════════════════════════════════╝
  459. }
  460.  
  461. PROCEDURE Error( Msg : STRING );
  462. BEGIN
  463.   WriteLn( Msg );
  464.   HALT( 1 );  { return an errorlevel of 1 to DOS for batchfile processing }
  465. END; { Error }
  466.  
  467. PROCEDURE ChameleonHelp;
  468. CONST Desc : ARRAY[ 1..MaxProg ] OF PathStr =
  469.              ( 'A "Touch" (file-date/timestamp modifier) program',
  470.                'A directory lister',
  471.                'A file-finder (that totals file sizes)',
  472.                'A file-attributer modifier',
  473.                'A counter of lines in textfiles' );
  474. VAR S3 : Str3;
  475.     I, J : BYTE;
  476. BEGIN
  477.   WriteLn;
  478.   STR( MaxProg, S3 );
  479.   WriteLn( 'Chameleon Help: this program can act in 1 of ' + S3 + ' ways:' );
  480.   FOR I := 1 TO 5 DO BEGIN
  481.     STR( I, S3 );
  482.     WriteLn( '  ', S3, '. ', Desc[ I ] );
  483.     Write( '     if the filename is one of these: ' );
  484.     FOR J := 1 TO MaxNames DO BEGIN
  485.       IF NOT ( ProgNameArray[ I, J ] = '' ) THEN BEGIN
  486.         IF ( J > 1 ) THEN Write( ',' );
  487.         Write( '  ', ProgNameArray[ I, J ] );
  488.       END;
  489.     END;
  490.     WriteLn;
  491.   END; { FOR I }
  492.   WriteLn( 'Alternatively, set the environment variable FADS to one of the above names.' );
  493.   WriteLn( 'The environment variable overrides the filename.' );
  494.   HALT;
  495. END; { ChameleonHelp }
  496.  
  497. PROCEDURE Help;
  498. CONST ChameleonKey : CHAR = 'C';
  499.       IncSubs     = '    /S            Include Subdirectories.';
  500.       AutoYes     = '    /Y            Automatically answer Yes to confirmation prompt.';
  501.       ForcePrompt = '    /1            Force confirmation prompt even if only one file.';
  502.       Dumb        = 'Including both /Y and /1 is dumb, and skips the confirmation prompt.';
  503.       DontPause   = '    /Y            Don''t pause after each screenful.';
  504.       Unless      = '          you are prompted to confirm, unless /Y is included.';
  505.       Output      = '    /W:file       Write output to file as well as to screen.  Assumes /Y.';
  506.       OutOver     = '    /WO           Overwrite output file (if it exists) without prompting.';
  507.       OutW1       = '       1 - echo command line';
  508.       OutW2       = '       2 - Starting directory & # of directories found';
  509.       OutW3       = '       3 - Directories (without number)';
  510.       OutW4       = '       4 - Directories with leading number and period (overrides 3)';
  511. VAR XX : BYTE;
  512.     Ch : CHAR;
  513.     ChamString : STRING;
  514.     FlagStr : DirStr;
  515.     LineNum : BYTE;
  516.  
  517.   PROCEDURE HelpLine( HLS : STRING );
  518.   CONST More = '- More - Press a key -';
  519.   VAR Ch : CHAR;
  520.   BEGIN
  521.     INC( LineNum );
  522.     IF ( LineNum = ( MaxRows - 1 ) ) THEN BEGIN
  523.       Write( More );
  524.       Ch:= READKEY;
  525.       IF KeyPressed THEN Ch:= READKEY;
  526.       GOTOXY( 1, WHEREY );
  527.       Write( Replicate( #32, LENGTH( More ) ) );
  528.       GOTOXY( 1, WHEREY );
  529.     END;
  530.     WriteLn( HLS );
  531.   END; { HelpLine }
  532.  
  533. BEGIN { Help }
  534.   ChamString := 'Press ' + ChameleonKey +
  535.                 ' for information on Chameleon feature of program.  Any other key exits.';
  536.   LineNum := 0;
  537.   CASE ProgramNum OF
  538.     ProgFD : BEGIN
  539.                HelpLine( ProgramName + ' will modify the timestamp (date & time) of a file.' );
  540.                HelpLine( NullStr );
  541.                HelpLine( 'Syntax: ' + ProgramName + ' pathname [/D[date]] [/T[time]] [/S] [/Y] [/1]' );
  542.                HelpLine( NullStr );
  543.                HelpLine( '    /D[mm-dd-yy]  Set the file date to [mm-dd-yy]' );
  544.                HelpLine( '    /T[hh:mm:ss]  Set the file time to [hour:minute:second]' );
  545.                HelpLine( IncSubs );
  546.                HelpLine( AutoYes );
  547.                HelpLine( ForcePrompt );
  548.                HelpLine( NullStr );
  549.                HelpLine( 'NOTES: 1. If more than one file''s timestamp would be modified,' );
  550.                HelpLine( Unless );
  551.                HelpLine( '       2. Files flagged ReadOnly, Hidden or System are not touched.' );
  552.                HelpLine( '       3. If you do not include /D or /T, ' + ProgramName + ' will set the file''s timestamp' );
  553.                HelpLine( '          to that of the current date & time.' );
  554.                HelpLine( '       4. Hour:minute:second can be from 00:00:00 to 23:59:59.' );
  555.                HelpLine( '       5. ' + Dumb );
  556.              END; { ProgFD }
  557.     ProgFA : BEGIN
  558.                HelpLine( ProgramName + ' will modify the attributes of a file.' );
  559.                HelpLine( NullStr );
  560.                Write( 'Syntax: ' + ProgramName + ' pathname ' );
  561.                XX := WHEREX;
  562.                HelpLine( '[/A+|/A-] [/R+|/R-] [/H+|/H-] [/SYS+|/SYS-]' );
  563.                GOTOXY( XX, WHEREY );
  564.                HelpLine( '[/S] [/Y] [/1]' );
  565.                HelpLine( NullStr );
  566.                HelpLine( '    /A+           Sets Archive attribute' );
  567.                HelpLine( '    /A-           Removes Archive attribute' );
  568.                HelpLine( '    /R+           Sets ReadOnly attribute' );
  569.                HelpLine( '    /R-           Removes ReadOnly attribute' );
  570.                HelpLine( '    /H+           Sets Hidden attribute' );
  571.                HelpLine( '    /H-           Removes Hidden attribute' );
  572.                HelpLine( '    /SYS+         Sets System attribute' );
  573.                HelpLine( '    /SYS-         Removes System attribute' );
  574.                HelpLine( IncSubs );
  575.                HelpLine( AutoYes );
  576.                HelpLine( ForcePrompt );
  577.                HelpLine( NullStr );
  578.                HelpLine( 'NOTES: 1. If more than one file''s attributes would be modified,' );
  579.                HelpLine( Unless );
  580.                HelpLine( '       2. ' + Dumb );
  581.              END; { ProgFA }
  582.     ProgFF : BEGIN
  583.                Write( ProgramName + #32 );
  584.                XX := WHEREX;
  585.                Write( 'finds files matching the pathname and specified attributes (if any)' );
  586.                IF CountLnsTF THEN BEGIN
  587.                  FlagStr := '[/S] ';
  588.                  HelpLine( NullStr );
  589.                  GOTOXY( XX, WHEREY );
  590.                  HelpLine( 'and counts the number of lines found in each.' );
  591.                END ELSE BEGIN
  592.                  FlagStr := '[/L] [/FIT:drive] [/C] ';
  593.                  HelpLine( '.' );
  594.                END;
  595.                Write( 'Syntax: ' + ProgramName + ' [pathname] ');
  596.                XX := WHEREX;
  597.                Write( '[/A[+/-]] [/R[+/-]] [/H[+/-]] [/SYS[+/-]]' );
  598.                IF NOT CountLnsTF THEN Write( ' [/S-] [/Z]' );
  599.                HelpLine( NullStr );
  600.                GOTOXY( XX, WHEREY );
  601.                HelpLine( '[/E:var] ' + FlagStr );
  602.                GOTOXY( XX, WHEREY );
  603.                HelpLine( '[/W:file] [/W[1][2][3][4][5][6][7]] [/WO] [/Y]' );
  604.                HelpLine( '    /A or /A+     Find files with Archive attribute set' );
  605.                HelpLine( '    /A-           Find files without Archive attribute set' );
  606.                HelpLine( '    /R or /R+     Find files with ReadOnly attribute set' );
  607.                HelpLine( '    /R-           Find files without ReadOnly attribute set' );
  608.                HelpLine( '    /H or /H+     Find files with Hidden attribute set' );
  609.                HelpLine( '    /H-           Find files without Hidden attribute set' );
  610.                HelpLine( '    /SYS or /SYS+ Find files with System attribute set' );
  611.                HelpLine( '    /SYS-         Find files without System attribute set' );
  612.                IF NOT CountLnsTF THEN BEGIN
  613.                  HelpLine( '    /S-           Exclude Subdirectories.  (default : search subdirectories)' );
  614.                  HelpLine( '    /Z            Scan through .ZIP files (sensitive to attrib) for filespec' );
  615.                END;
  616.                HelpLine( '    /E:var        Search the only directories listed in environment variable' );
  617.                HelpLine( '                  named after E:.  (e.g. /E:PATH)' );
  618.                IF CountLnsTF THEN HelpLine( IncSubs ) ELSE BEGIN
  619.                  HelpLine( '    /L            Count lines in files ( NOTE: Textfiles are assumed! ).' );
  620.                  HelpLine( '    /FIT:drive    Determine space required to copy found files to drive.' );
  621.                  HelpLine( '    /C            Cluster size scenarios.' );
  622.                END;
  623.                HelpLine( Output );
  624.                HelpLine( '    /W[1][2][3][4][5][6][7]  Write to output file (default all) e.g./W1246' );
  625.                HelpLine( OutW1 );
  626.                HelpLine( OutW2 );
  627.                HelpLine( OutW3 );
  628.                HelpLine( OutW4 );
  629.                HelpLine( '       5 - File information' );
  630.                HelpLine( '       6 - # of file found' );
  631.                HelpLine( '       7 - bytes summary information' );
  632.                HelpLine( OutOver );
  633.                HelpLine( DontPause );
  634.                HelpLine( 'NOTES: 1. Default starting search directory is the CURRENT directory.' );
  635.                HelpLine( '       2. Default filespec is *.*.  Additional filespecs may be added.' );
  636.                IF NOT CountLnsTF
  637.                  THEN HelpLine( '       3. Files found in ZIPs have compressed size listed under "Space Used".' );
  638.              END; { ProgFF }
  639.     ProgLD : BEGIN
  640.                HelpLine( ProgramName + ' lists directories starting at the specified directory.' );
  641.                HelpLine( NullStr );
  642.                HelpLine( 'Syntax: ' + ProgramName + ' [starting directory] [/W:file] [/W[1][2][3][4]] [/WO] [/Y]');
  643.                HelpLine( NullStr );
  644.                HelpLine( Output );
  645.                HelpLine( '    /W[1][2][3][4]  Write to output file (default all) e.g./W23' );
  646.                HelpLine( OutW1 );
  647.                HelpLine( OutW2 );
  648.                HelpLine( OutW3 );
  649.                HelpLine( OutW4 );
  650.                HelpLine( OutOver );
  651.                HelpLine( DontPause );
  652.                HelpLine( NullStr );
  653.                HelpLine( 'NOTES: 1. The default starting directory is the CURRENT directory.' );
  654.              END; { ProgLD }
  655.   END; { CASE ProgramNum }
  656.   Write( ChamString );
  657.   Ch := UpCase( READKEY );
  658.   GOTOXY( 1, WHEREY );
  659.   Write( Replicate( #32, LENGTH( ChamString ) ) );
  660.   GOTOXY( 1, WHEREY );
  661.   IF ( Ch = ChameleonKey ) THEN ChameleonHelp;
  662.   HALT;
  663. END; { Help }
  664.  
  665. {
  666. ╔══════════════════════════════════════════════════════════════════════════╗
  667. ║ GetSys puts current date & time into global DateTime record SysDT        ║
  668. ╚══════════════════════════════════════════════════════════════════════════╝
  669. }
  670.  
  671. PROCEDURE GetSys;
  672. VAR h, m, s, hund : Word;
  673. BEGIN
  674.   GetTime( h, m, s, hund );
  675.   SysDT.Hour := h;
  676.   SysDT.Min  := m;
  677.   SysDT.Sec  := s;
  678.  
  679.   GetDate( h, m, s, hund );  { re-use Word vars }
  680.   SysDT.Year  := h;
  681.   SysDT.Month := m;
  682.   SysDT.Day   := s;
  683. END; { GetSys }
  684.  
  685. {
  686. ╔══════════════════════════════════════════════════════════════════════════╗
  687. ║ Sort Array Index ( L = beginning element & R= ending element )           ║
  688. ╚══════════════════════════════════════════════════════════════════════════╝
  689. }
  690. PROCEDURE QuickSort( VAR Index : IndexArray; L, R : WORD );
  691. VAR I, J : WORD;
  692.     X, Y : PathRecPtr;
  693. BEGIN
  694.   I := L;
  695.   J := R;
  696.   X := Index[ ( L + R ) DIV 2 ];
  697.   REPEAT
  698.     WHILE ( Index[ I ]^.P < X^.P ) DO INC( I );
  699.     WHILE ( X^.P < Index[ J ]^.P ) DO DEC( J );
  700.     IF I <= J THEN BEGIN
  701.       Y := Index[ I ];
  702.       Index[ I ] := Index[ J ];
  703.       Index[ J ] := Y;
  704.       INC( I );
  705.       DEC( J );
  706.     END;
  707.   UNTIL ( I > J );
  708.   IF L < J THEN QuickSort( Index, L, J );
  709.   IF I < R THEN QuickSort( Index, I, R );
  710. END; { QuickSort }
  711.  
  712. {
  713. ╔══════════════════════════════════════════════════════════════════════════╗
  714. ║ Directory scanning routines                                              ║
  715. ╚══════════════════════════════════════════════════════════════════════════╝
  716. }
  717.  
  718. PROCEDURE AddNewIndex( VAR Total : WORD );
  719. CONST QuitStr = '   Quit now? ( Y / N ) -> ';
  720. VAR Ch : CHAR;
  721.     YY, XX : BYTE;
  722. BEGIN
  723.   INC( Total );
  724.   IF ( Total > MaxDirs ) THEN
  725.     Error( 'Exceeded maximum # of directories.  Scream at programmer about MaxDirs.' );
  726.   IF ( MaxAvail < SizeOf( PathRec ) ) THEN
  727.     Error( 'Insufficient memory.  Bummer.' );
  728.   NEW( Index[ Total ] );
  729.   UserEscQuit;
  730. END; { AddNewIndex }
  731.  
  732. PROCEDURE AddDirToList( D : DirStr; CheckForDupeTF : BOOLEAN );
  733. VAR S12 : Str12;
  734.     I : WORD;
  735. BEGIN
  736.   IF CheckForDupeTF THEN BEGIN
  737.     CheckForDupeTF := FALSE; { Re-use BOOLEAN variable - perfect! }
  738.     FOR I := 1 TO DirTotal DO
  739.       IF ( D = Index[ I ]^.P ) THEN CheckForDupeTF := TRUE;
  740.     IF CheckForDupeTF THEN EXIT;  { don't add dupe dir from user's "PATH" }
  741.   END;
  742.   AddNewIndex( DirTotal );
  743.   Index[ DirTotal ]^.P := D;
  744.   GOTOXY( 1, YY );
  745.   IF ( DirTotal > 1 ) THEN S12 := 'ies' ELSE S12 := 'y';
  746.   Write( DirTotal, ' director', S12, ' found.' );
  747. END; { AddDirToList }
  748.  
  749. PROCEDURE GetDirList( SD : DirStr );
  750. VAR DirInfo : SearchRec;
  751. BEGIN
  752.   ChDir( SD );
  753.   FindFirst( '*.*', Directory, DirInfo );
  754.   WHILE ( DosError = 0 ) DO BEGIN
  755.     IF ( DirInfo.Attr AND Directory = Directory ) AND  { Directory attribute }
  756.        ( DirInfo.Name[ 1 ] <> '.' )                    { No dot directories }
  757.       THEN AddDirToList( FullName( SD, DirInfo.Name ), FALSE );
  758.     FindNext( DirInfo );
  759.   END;
  760. END; { GetDirList }
  761.  
  762. {
  763. ╔══════════════════════════════════════════════════════════════════════════╗
  764. ║ ProcessFiles counts and, if ModifyNowTF is TRUE, updates the timestamp   ║
  765. ║ of the files specified.                                                  ║
  766. ╚══════════════════════════════════════════════════════════════════════════╝
  767. }
  768.  
  769. PROCEDURE ProcessFiles( ModifyNowTF : BOOLEAN ); { Touch( FD ) & FA }
  770. VAR DirInfo : SearchRec;
  771.     I : WORD;
  772.     F : FILE;
  773.     Ftime : LONGINT;
  774.     DTstr : STRING;
  775.     CancelTF : BOOLEAN;
  776.     ADflag, NA : BYTE;  { Access denied flag }
  777.  
  778.   PROCEDURE CountUpdate;
  779.   VAR S12 : Str12;
  780.   BEGIN
  781.     IF ( NumFiles > 1 ) THEN S12 := 's' ELSE S12 := '';
  782.     IF ModifyNowTF THEN BEGIN
  783.       GOTOXY( 1, YY + 1 );
  784.       Write( #32, NumFiles, ' file', S12, ' updated.' );
  785.     END ELSE Write( #32, NumFiles );
  786.   END; { CountUpdate }
  787.  
  788.   PROCEDURE NewFtime;
  789.   VAR NewDT : DateTime;
  790.   BEGIN
  791.     IF ( ( CodeDate = ValFile ) OR ( CodeTime = ValFile ) ) THEN BEGIN
  792.       GetFTime( F, Ftime );   { File must be OPENed to get its timestamp }
  793.       UnpackTime( Ftime, NewDT );
  794.     END;
  795.     IF ( CodeDate = ValSys ) THEN BEGIN
  796.       NewDT.Year  := SysDT.Year;
  797.       NewDT.Month := SysDT.Month;
  798.       NewDT.Day   := SysDT.Day;
  799.     END;
  800.     IF ( CodeDate = ValArg ) THEN BEGIN
  801.       NewDT.Year  := ArgDT.Year;
  802.       NewDT.Month := ArgDT.Month;
  803.       NewDT.Day   := ArgDT.Day;
  804.     END;
  805.     IF ( CodeTime = ValSys ) THEN BEGIN
  806.       NewDT.Hour  := SysDT.Hour;
  807.       NewDT.Min   := SysDT.Min;
  808.       NewDT.Sec   := SysDT.Sec;
  809.     END;
  810.     IF ( CodeTime = ValArg ) THEN BEGIN
  811.       NewDT.Hour  := ArgDT.Hour;
  812.       NewDT.Min   := ArgDT.Min;
  813.       NewDT.Sec   := ArgDT.Sec;
  814.     END;
  815.     PackTime( NewDT, Ftime );  { set Ftime to "packed" time format }
  816.     DTstr := DateTimeStr( NewDT.Month, NewDT.Day, NewDT.Year ) +
  817.              Replicate( #32, 3 ) +
  818.              DateTimeStr( NewDT.Hour, NewDT.Min, NewDT.Sec );
  819.   END; { NewFtime }
  820.  
  821.   FUNCTION NewAttrib : BYTE; { Returns modified DirInfo.Attr }
  822.   VAR NA, I : BYTE;
  823.   BEGIN { NewAttrib }
  824.     NA := DirInfo.Attr;
  825.     FOR I := 1 TO 4 DO IF ( AttrFlag[ I ] <> 0 ) THEN BEGIN
  826.       IF ( AttrFlag[ I ] = 1 ) THEN NA := NA OR AttrVal[ I ]
  827.         ELSE IF ( AttrFlag[ I ] = -1 ) THEN
  828.         IF ( ( NA AND AttrVal[ I ] ) > 0 ) THEN DEC( NA, AttrVal[ I ] );
  829.     END; { FOR  I }
  830.     NewAttrib := NA;
  831.   END; { NewAttrib }
  832.  
  833.   PROCEDURE AccessDenied( ADbyte : BYTE );
  834.   CONST AD = 'Access denied.  Press a key.';
  835.   VAR XX : BYTE;
  836.       Ch : CHAR;
  837.   BEGIN
  838.     ADflag := ADbyte;
  839.     XX := WHEREX;
  840.     Write( AD );
  841.     IF ( NOT AutoYesTF ) THEN Ch := READKEY;
  842.     IF ( Ch = #3 ) THEN CancelTF := TRUE;
  843.     GOTOXY( XX, WHEREY );
  844.     Write( Replicate( #32, LENGTH( AD ) ) );
  845.     GOTOXY( XX, WHEREY );
  846.     DEC( NumFiles );
  847.   END; { AccessDenied }
  848.  
  849. BEGIN  { ProcessFiles }
  850.   CancelTF := FALSE;
  851.   NumFiles := 0;
  852.   FOR I := 1 TO DirTotal DO BEGIN
  853.     ChDir( Index[ I ]^.P );
  854.     FindFirst( PS, AnyFile, DirInfo );
  855.     WHILE ( DosError = 0 ) DO BEGIN
  856.       IF ( DirInfo.Attr AND Directory <> Directory ) AND    { Not a Directory }
  857.          ( DirInfo.Attr AND VolumeID <> VolumeID ) THEN BEGIN { Not a Volume label }
  858.  
  859.         IF ( ProgramNum = ProgFA ) OR
  860.            ( ( DirInfo.Attr AND ReadOnly <> ReadOnly ) AND  { Not a ReadOnly file }
  861.              ( DirInfo.Attr AND Hidden <> Hidden ) AND      { Not a Hidden file }
  862.              ( DirInfo.Attr AND SysFile <> SysFile ) ) THEN { Not a System file }
  863.         BEGIN
  864.           INC( NumFiles );
  865.           GOTOXY( 1, YY );
  866.           Write( PadR( DirInfo.Name, 15 ) );
  867.           ADflag := 0;
  868.           IF ModifyNowTF THEN BEGIN
  869.             ASSIGN( F, DirInfo.Name );
  870.             IF ( ProgramNum = ProgFD ) THEN BEGIN
  871.               {$I-}
  872.               RESET( F );
  873.               {$I+}
  874.               IF ( IOresult = 0 ) THEN BEGIN
  875.                 NewFtime;
  876.                 {$I-}
  877.                 SetFTime( F, Ftime );   { File must be OPENed to set its timestamp }
  878.                 {$I+}
  879.                 IF ( IOresult = 0 ) THEN Write( DTstr ) ELSE AccessDenied( 2 );
  880.               END ELSE AccessDenied( 1 ); { fail on OpenFile, i.e. Reset }
  881.               IF ( ADflag <> 1 ) THEN CLOSE( F );
  882.             END ELSE BEGIN { FA }
  883.               NA := NewAttrib;
  884.               IF ( NA = DirInfo.Attr ) THEN BEGIN
  885.                 Write( 'No change needed.' );
  886.                 DEC( NumFiles );
  887.               END ELSE BEGIN
  888.                 {$I-}
  889.                 SetFAttr( F, NA );
  890.                 {$I+}
  891.                 IF ( IOresult = 0 ) AND ( DosError = 0 )
  892.                   THEN Write( AttributeStr( DirInfo.Attr ),
  893.                               '  =>  ', AttributeStr( NA ) )
  894.                   ELSE AccessDenied( 3 );
  895.               END; { ( NA <> DirInfo.Attr ) }
  896.             END;
  897.             IF CancelTF THEN BEGIN
  898.               WriteLn( UserBreak );
  899.               EXIT;
  900.             END;
  901.           END; { IF ModifyNowTF }
  902.           CountUpdate;
  903.         END; { If ( ProgramNum = ProgFA ) OR (not READONLY,HIDDEN,SYSTEM) }
  904.       END; { If not DIRECTORY and not VOLUME }
  905.       FindNext( DirInfo );
  906.     END;
  907.   END; { FOR I }
  908.   IF ModifyNowTF THEN WriteLn ELSE GOTOXY( 1, YY );
  909. END; { ProcessFiles }
  910.  
  911. {
  912. ╔══════════════════════════════════════════════════════════════════════════╗
  913. ║ ModifyFileTime:                                                          ║
  914. ║ * if only one file matches filespec on command line,                     ║
  915. ║   that file is touched without additional prompting                      ║
  916. ║ * if more than one file matches filespec,                                ║
  917. ║   user is told how many files would be touched,                          ║
  918. ║   then prompted for confirmation once before action is performed         ║
  919. ║   on all files.                                                          ║
  920. ╚══════════════════════════════════════════════════════════════════════════╝
  921. }
  922.  
  923. PROCEDURE ModifyFileTime;
  924. VAR Ch : CHAR;
  925.     XX, YY, XP, YP : BYTE;
  926. BEGIN
  927.   IF ( NumFiles = 0 ) THEN WriteLn( 'No matching files found.  Note: ' +
  928.      ProgramName + ' ignores ReadOnly/Hidden/System files.' )
  929.   ELSE IF ( ( NumFiles = 1 ) AND ( NOT ForcePromptTF ) ) THEN BEGIN
  930.     GetSys; { Get System Date & Time into DateTime record SysDT }
  931.     ProcessFiles( TRUE );
  932.   END ELSE BEGIN
  933.     IF AutoYesTF THEN Ch := 'Y' ELSE BEGIN
  934.       Write( 'Timestamps of ', NumFiles,
  935.              ' files will have ' );
  936.       XX := WHEREX;
  937.       YY := WHEREY;
  938.       GOTOXY( XX, YY - 1);
  939.       Write( #201, #32, UserDateStr ); {201} {218}
  940.       GOTOXY( XX, YY );
  941.       WriteLn( #202, #32, UserTimeStr ); {202} {193}
  942.       XP := WHEREX;
  943.       YP := WHEREY;
  944.       Write( Proceed );
  945.       REPEAT
  946.         Ch := UpCase( ReadKey );
  947.         IF ( Ch IN [ #3, #27 ] ) THEN Ch := 'N';
  948.       UNTIL ( Ch IN [ 'Y', 'N' ] );
  949.       IF ( Ch = 'N' ) THEN WriteLn( Ch );
  950.     END;
  951.     IF ( Ch = 'Y' ) THEN BEGIN
  952.       GOTOXY( XP, YP );
  953.       Write( Replicate( #32, LENGTH( Proceed ) ) );
  954.       GOTOXY( XX, YY - 1 );
  955.       Write( Replicate( #32, 2 + LENGTH( UserDateStr ) ) );
  956.       GOTOXY( XX, YY );
  957.       Write( Replicate( #32, 2 + LENGTH( UserTimeStr ) ) );
  958.       GetSys; { Get System Date & Time into DateTime record SysDT }
  959.       ProcessFiles( TRUE );
  960.     END;
  961.   END;
  962. END; { ModifyFileTime }
  963.  
  964. {
  965. ╔══════════════════════════════════════════════════════════════════════════╗
  966. ║ ModifyFileAttr:                                                          ║
  967. ║ * if only one file matches filespec on command line,                     ║
  968. ║   that file's attributes are changed without additional prompting        ║
  969. ║ * if more than one file matches filespec,                                ║
  970. ║   user is told how many files would be affected,                         ║
  971. ║   then prompted for confirmation once before action is performed         ║
  972. ║   on all files.                                                          ║
  973. ╚══════════════════════════════════════════════════════════════════════════╝
  974. }
  975.  
  976. PROCEDURE ModifyFileAttr;
  977. VAR Ch : CHAR;
  978.     XX, YY : BYTE;
  979. BEGIN
  980.   IF ( NumFiles = 0 ) THEN WriteLn( 'No matching files found.' )
  981.   ELSE IF ( ( NumFiles = 1 ) AND ( NOT ForcePromptTF ) ) THEN BEGIN
  982.     ProcessFiles( TRUE );
  983.   END ELSE BEGIN
  984.     IF AutoYesTF THEN Ch := 'Y' ELSE BEGIN
  985.       XX := WHEREX;
  986.       YY := WHEREY;
  987.       Write( 'Attributes of ', NumFiles,
  988.              ' files will be changed. ' );
  989.       Write( Proceed );
  990.       REPEAT
  991.         Ch := UpCase( ReadKey );
  992.         IF ( Ch IN [ #3, #27 ] ) THEN Ch := 'N';
  993.       UNTIL ( Ch IN [ 'Y', 'N' ] );
  994.       IF ( Ch = 'N' ) THEN WriteLn( Ch );
  995.     END;
  996.     IF ( Ch = 'Y' ) THEN BEGIN
  997.       GOTOXY( XX, YY );
  998.       Write( BlankLine );
  999.       ProcessFiles( TRUE );
  1000.     END;
  1001.   END;
  1002. END;  { ModifyFileAttr }
  1003.  
  1004. PROCEDURE ListDirs( ProgNum : BYTE );
  1005. CONST Banner = '  FileName        Date        Time     Attr          Size    ';
  1006.       ChSortLast  = #255;
  1007.       ChZipMark   = #1;
  1008.       ChZipBullet = #254;
  1009. VAR L, NL, NM, RowsShown, MaxScrnY, EnoughSpace : BYTE;
  1010.     S12 : Str12;
  1011.     CurDirNo, CurFileNo, FileCount : WORD;
  1012.     ShowFileTF, UserCancelTF, MultClusterTF, FinishedTF : BOOLEAN;
  1013.     FileBanner : PathStr;
  1014.     S : STRING;
  1015.     ClusterPart, ClusterCluster : LONGINT; { a little redundant,
  1016.                                              but Robin Williams says it's OK }
  1017.  
  1018.   FUNCTION NoOfDirsInDS : WORD;
  1019.   VAR I, DStotal : WORD;
  1020.  
  1021.     PROCEDURE AddDS( D : DirStr ); { D always begin with drive-letter:\ }
  1022.     VAR I : WORD;
  1023.     BEGIN
  1024.       IF ( DStotal > 0 ) THEN FOR I := 1 TO DStotal DO
  1025.         IF ( D = Index[ DirTotal + I ]^.P ) THEN EXIT;
  1026.       INC( DStotal );
  1027.       IF ( DStotal + DirTotal > FileTotal ) THEN AddNewIndex( FileTotal );
  1028.       Index[ DStotal + DirTotal ]^.P := D;
  1029.     END; { AddDS }
  1030.  
  1031.     PROCEDURE BuildDS( D : DirStr ); { D always begin with drive-letter:\ }
  1032.     VAR I, J : BYTE;
  1033.     BEGIN
  1034.       IF ( LENGTH( D ) = 3 ) THEN EXIT; { Skip root directory }
  1035.       D := D + '\';
  1036.       J := 0;
  1037.       FOR I := 1 TO LENGTH( D ) DO IF ( D[ I ] = '\' ) THEN BEGIN
  1038.         INC( J );
  1039.         IF ( J > 1 ) THEN AddDS( COPY( D, 1, I ) );
  1040.       END;
  1041.     END; { BuildDS }
  1042.  
  1043.   BEGIN { NoOfDirsInDS }
  1044.     DStotal := 0;
  1045.     FOR I := 1 TO DirTotal DO IF Index[ I ]^.TF THEN BuildDS( Index[ I ]^.P );
  1046.     NoOfDirsInDS := DStotal;
  1047.   END; { NoOfDirsInDS }
  1048.  
  1049.   FUNCTION FileInfo( DirInfo : SearchRec ) : PathStr;
  1050.   VAR DT : DateTime;
  1051.       SpaceUsed, OtherCS, Lines : LONGINT;
  1052.       LastInfoCol : Str20;
  1053.       AttrStr : Str12;
  1054.       FR : TEXT;
  1055.       A : STRING;
  1056.       I : BYTE;
  1057.   BEGIN
  1058.     UnpackTime( DirInfo.Time, DT );
  1059.     IF ( EnvVar = '' ) OR ( DrvSource = Index[ CurDirNo ]^.P[ 1 ] ) THEN
  1060.       SpaceUsed := ByteAdjust( DirInfo.Size, Clusticity[ 1 ] )
  1061.     ELSE BEGIN
  1062.       OtherCS := ByteClust( ORD( Index[ CurDirNo ]^.P[ 1 ] ) - 64 );
  1063.       IF ( OtherCS <> Clusticity[ 1 ] ) THEN MultClusterTF := TRUE;
  1064.       SpaceUsed := ByteAdjust( DirInfo.Size, OtherCS );
  1065.     END;
  1066.     INC( SpaceTotal[ 0 ], DirInfo.Size );
  1067.     INC( SpaceTotal[ 1 ], SpaceUsed );
  1068.     IF ( Clusticity[ 2 ] > 0 ) THEN
  1069.       INC( TargetSpace[ 1 ], ByteAdjust( DirInfo.Size, Clusticity[ 2 ] ) );
  1070.  
  1071.     FOR I := 1 TO MaxClustChk DO
  1072.        INC( SpaceCluster[ I, 1 ],
  1073.             ByteAdjust( DirInfo.Size, 1024 * Power( 2, I ) ) );
  1074.  
  1075.     AttrStr := AttributeStr( DirInfo.Attr );
  1076.  
  1077.     IF CountLnsTF THEN BEGIN
  1078.       Lines := 0;  { # of lines }
  1079.       ASSIGN( FR, DirInfo.Name );
  1080.       {$I-}
  1081.       RESET( FR );
  1082.       {$I+}
  1083.       IF ( IOresult = 0 ) THEN BEGIN
  1084.         REPEAT
  1085.           READLN( FR, A );
  1086.           INC( Lines );
  1087.         UNTIL EOF( FR );
  1088.         CLOSE( FR );
  1089.         LastInfoCol := PrintUsing( Lines );
  1090.       END ELSE LastInfoCol := 'AccessDenied/L';
  1091.       INC( LinesTotal, Lines );
  1092.     END ELSE LastInfoCol := PrintUsing( SpaceUsed );
  1093.  
  1094.     FileInfo := PadR( DirInfo.Name, 15 ) +
  1095.                 DateTimeStr( DT.Month, DT.Day, DT.Year ) +
  1096.                 Replicate( #32, 3 ) +
  1097.                 DateTimeStr( DT.Hour, DT.Min, DT.Sec ) +
  1098.                 Replicate( #32, 3 ) + AttrStr +
  1099.                 PadL( PrintUsing( DirInfo.Size ), 14 ) +
  1100.                 PadL( LastInfoCol, 14 );
  1101.   END;  { FileInfo }
  1102.  
  1103.   PROCEDURE GetFiles;
  1104.   CONST BT = 3; { # of files to read before changing "busy" character }
  1105.   VAR DirInfo : SearchRec;
  1106.       XX, NB, L : BYTE;
  1107.       NBT, LL : WORD;
  1108.  
  1109.     FUNCTION ChkAttribs : BOOLEAN;
  1110.     VAR TF : BOOLEAN;
  1111.         I : BYTE;
  1112.  
  1113.       FUNCTION ChkAttr( AttrVal : BYTE; Flag : SHORTINT ) : BOOLEAN;
  1114.       VAR RetTF : BOOLEAN;
  1115.       BEGIN
  1116.         RetTF := ( DirInfo.Attr AND AttrVal = AttrVal );
  1117.         IF ( Flag = 1 ) THEN ChkAttr := RetTF
  1118.                         ELSE ChkAttr := NOT RetTF;
  1119.       END; { ChkAttr }
  1120.  
  1121.     BEGIN { ChkAttribs }
  1122.       TF := TRUE;
  1123.       FOR I := 1 TO 4 DO IF ( AttrFlag[ I ] <> 0 ) THEN TF := FALSE;
  1124.       IF TF THEN ChkAttribs := TRUE ELSE BEGIN
  1125.         FOR I := 1 TO 4 DO BEGIN
  1126.           IF ( AttrFlag[ I ] <> 0 ) THEN BEGIN
  1127.             TF := ChkAttr( AttrVal[ I ], AttrFlag[ I ] );
  1128.             IF TF THEN BREAK; { no need to check for further attributes }
  1129.           END;
  1130.         END; { FOR I }
  1131.       END;
  1132.       ChkAttribs := TF;
  1133.     END;  { ChkAttribs }
  1134.  
  1135.     PROCEDURE AddFile( P : InfoStr );
  1136.     BEGIN
  1137.       INC( FileCount );
  1138.       IF ( DirTotal + FileCount > FileTotal )
  1139.         THEN AddNewIndex( FileTotal );
  1140.       Index[ DirTotal + FileCount ]^.P := P;
  1141.     END; { AddFile }
  1142.  
  1143.     PROCEDURE CheckMultSpec;
  1144.     VAR I : BYTE;
  1145.         Match12 : Str12;
  1146.         MatchTF : BOOLEAN;
  1147.  
  1148.       { ZipScan was adapted from source code found on CompuServe.
  1149.         Thanks to the author, whose name I cannot find. }
  1150.       PROCEDURE ZipScan;
  1151.       CONST SigFile = 'PK' + #3 + #4;  {Signature = 'PK'+#1+#2 -> Central dir}
  1152.             Scanning = 'Scanning ZIP file ';
  1153.       VAR Zip       : FILE;
  1154.           Signature : ARRAY[ 1..4 ] OF CHAR;
  1155.           ZFdata    : ARRAY[ 1..26 ] OF CHAR;
  1156.           orig_time : INTEGER;
  1157.           orig_date : INTEGER;
  1158.           comp_size : LONGINT;
  1159.           uncomp    : LONGINT;
  1160.           fn_size   : INTEGER;
  1161.           extra     : INTEGER;
  1162.           file_name : ARRAY[ 1..79 ] OF CHAR;
  1163.           Result    : WORD;
  1164.           MatchSpecTF : BOOLEAN;
  1165.           S12       : Str12;
  1166.           I, XX, NB : BYTE;
  1167.           ScanMsg   : DirStr;
  1168.       (*  method    : INTEGER; {0=stored,1=shrunk,2-5=reduced,6=imploded} *)
  1169.  
  1170.         FUNCTION Bin2Dec( StringVar : STRING ) : INTEGER;
  1171.         VAR RetVal : INTEGER;
  1172.             K, L : BYTE;
  1173.         BEGIN
  1174.           RetVal := 0;
  1175.           FOR K := 1 TO LENGTH( StringVar ) DO BEGIN
  1176.             IF ( StringVar[ K ] = '0' ) THEN L := 0 ELSE L := 1;
  1177.             RetVal := L + RetVal + RetVal;
  1178.             END;
  1179.           Bin2Dec := RetVal;
  1180.         END; { Bin2Dec }
  1181.  
  1182.         FUNCTION Bin2I( S2 : Str2 ) : INTEGER;
  1183.         BEGIN
  1184.           Bin2I := ORD( S2[ 1 ] ) + 256 * ORD( S2[ 2 ] );
  1185.         END; { Bin2I }
  1186.  
  1187.         FUNCTION Bin2L( S4 : Str4 ) : LONGINT;
  1188.         VAR  L, M : LONGINT;
  1189.              K  : BYTE;
  1190.         BEGIN
  1191.           L := 0;
  1192.           M := 1;
  1193.           FOR K := 1 TO 4 DO BEGIN
  1194.             L := L + ORD( S4[ K ] ) * M;
  1195.             IF (K < 4) THEN M := M * 256;
  1196.             END;
  1197.           Bin2L := L;
  1198.  
  1199.       (*  does not work (yields negative values for large numbers)
  1200.           Bin2L := ORD(S4[1]) + 256 * ORD(S4[2])
  1201.                    + 65536 * ORD(S4[3]) + 16777216 * ORD(S4[4]); *)
  1202.         END; { Bin2L }
  1203.  
  1204.         FUNCTION Dec2Bin( IntegerVar : INTEGER ) : Str16;
  1205.         VAR RetVal : Str16;
  1206.             Remainder, Quotient : INTEGER;
  1207.         BEGIN
  1208.           RetVal := NullStr;
  1209.           REPEAT
  1210.              Quotient  := TRUNC( IntegerVar / 2 );
  1211.              Remainder := ABS( IntegerVar ) - 2 * ABS( Quotient );
  1212.              RetVal := COPY( '01', Remainder + 1, 1 ) + RetVal;
  1213.              IntegerVar := Quotient;
  1214.           UNTIL ( Quotient = 0 );
  1215.           WHILE ( LENGTH( RetVal ) < 16 ) DO RetVal := '0' + RetVal;
  1216.           Dec2Bin := RetVal;
  1217.         END; { Dec2Bin }
  1218.  
  1219.         FUNCTION DosDate( DateStamp : INTEGER ) : Str16;
  1220.         VAR yy,
  1221.             mm,
  1222.             dd  : INTEGER;
  1223.             S16 : Str16;
  1224.             S4  : Str4;
  1225.         BEGIN
  1226.           S16 := Dec2Bin( DateStamp );
  1227.           yy := Bin2Dec( COPY( S16, 1, 7 ) ) + 1980;
  1228.           mm := Bin2Dec( COPY( S16, 8, 4 ) );
  1229.           dd := Bin2Dec( COPY( S16, 12, 5 ) );
  1230.           STR( mm : 2, S16 );
  1231.           STR( dd : 2, S4 );
  1232.           S16 := Zero( S16 ) + '-' + Zero( S4 );
  1233.           STR( yy : 4, S4 ); { @@ }
  1234.           S16 := S16 + '-' + S4;
  1235.           DosDate := S16;
  1236.         END; { DosDate }
  1237.  
  1238.         FUNCTION DosTime( TimeStamp : INTEGER ) : Str8;
  1239.         VAR hh,
  1240.             mm,
  1241.             ss  : INTEGER;
  1242.             S16 : Str16;
  1243.             S2  : Str2;
  1244.             S8  : Str8;
  1245.         BEGIN
  1246.           S16 := Dec2Bin( TimeStamp );
  1247.           hh := Bin2Dec( COPY( S16, 1, 5 ) );
  1248.           mm := Bin2Dec( COPY( S16, 6, 6 ) );
  1249.           ss := Bin2Dec( COPY( S16, 12, 5 ) ); {2-second intervals (0-29)}
  1250.           STR( hh : 2, S8 );
  1251.           STR( mm : 2, S2 );
  1252.           S8 := Zero( S8 ) + ':' + Zero( S2 );
  1253.           STR( ss : 2, S2 );
  1254.           S8 := Zero( S8 ) + ':' + Zero( S2 );
  1255.           DosTime := S8 + '   ';
  1256.         END; { DosTime }
  1257.  
  1258.       BEGIN  { ZipScan }
  1259.         MatchSpecTF := FALSE;
  1260.         ScanMsg := 'Scanning ZIP file ' + DirInfo.Name + '...';
  1261.         XX := WHEREX;
  1262.         NB := 0;
  1263.         Write( ScanMsg );
  1264.         ASSIGN( Zip, DirInfo.Name );
  1265.         FileMode := 0; { ReadOnly }
  1266.       {$I-}
  1267.         RESET( Zip, 1 );
  1268.       {$I+}
  1269.        { To examine IOresult, save it to IOvalue, a global INT var. }
  1270.         IF ( IOresult = 0 ) THEN BEGIN
  1271.           WHILE ( NOT EOF( Zip ) ) DO BEGIN
  1272.             BLOCKREAD( Zip, Signature, 4, Result );
  1273.             IF ( Signature = SigFile ) THEN BEGIN
  1274.               BLOCKREAD( Zip, ZFdata, 26, Result );
  1275.               comp_size := Bin2L( COPY( ZFdata, 15, 4 ) ); { compressed size }
  1276.               fn_size   := Bin2I( COPY( ZFdata, 23, 2 ) ); { filename size }
  1277.               extra     := Bin2I( COPY( ZFdata, 25, 2 ) ); { comment size }
  1278.  
  1279.               BLOCKREAD( Zip, file_name, fn_size, Result );
  1280.               Seek( Zip, FilePos( Zip ) + extra + comp_size );
  1281.               { skip past comments & compressed file }
  1282.  
  1283.               IF ( Result > 0 ) THEN BEGIN
  1284.                 S12 := NullStr;
  1285.                 FOR I := Result DOWNTO 1 DO
  1286.                 IF ( file_name[ I ] = '/' ) THEN BREAK
  1287.                                             ELSE S12 := file_name[ I ] + S12;
  1288.  
  1289.                 Match12 := File12( S12 );
  1290.                 MatchSpecTF := Match( Match12, File12( PS ) );
  1291.                 IF ( PSaddCount > 0 ) THEN FOR I := 1 TO PSaddCount
  1292.                   DO MatchSpecTF := MatchSpecTF OR
  1293.                                     Match( Match12, File12( PSadd[ I ] ) );
  1294.                 IF MatchSpecTF THEN BEGIN
  1295.                   IF ( NOT MatchTF ) THEN BEGIN
  1296.                     MatchTF := TRUE;
  1297.                     AddFile( FileInfo( DirInfo ) );
  1298.                   END;
  1299.                   orig_time := Bin2I( COPY( ZFdata, 7, 2 ) );  { file time }
  1300.                   orig_date := Bin2I( COPY( ZFdata, 9, 2 ) );  { file date }
  1301.                   uncomp    := Bin2L( COPY( ZFdata, 19, 4 ) ); { uncompressed size }
  1302.                   AddFile( PadR( DirInfo.Name, 15 ) + ChSortLast +
  1303.                            ChZipMark + ChZipBullet + ' ' + PadR( S12, 13 ) +
  1304.                            DosDate( orig_date ) + Replicate( #32, 3 ) +
  1305.                            DosTime( orig_time ) + ' in ZIP' +
  1306.                            PadL( PrintUsing( uncomp ), 14 ) +
  1307.                            PadL( PrintUsing( comp_size ), 14 ) );
  1308.                   (*
  1309.                   method    := Bin2I( COPY( ZFdata, 5, 2) );
  1310.                   { compression method, see VAR above }
  1311.                   *)
  1312.                 END;   { IF MatchSpecTF }
  1313.               END;     { ( Result > 0 ) }
  1314.             END;        { If Signature = }
  1315.  
  1316.             INC( NB );
  1317.             IF ( NB > 4 ) THEN NB := 1;
  1318.             GOTOXY( LENGTH( ScanMsg ) + XX, WHEREY );
  1319.             Write( Busy[ NB ] );
  1320.  
  1321.             IF KeyPressed THEN BEGIN
  1322.               GOTOXY( XX, WHEREY );
  1323.               Write( Replicate( #32, LENGTH( ScanMsg ) + 1 ) );
  1324.               GOTOXY( XX, WHEREY );
  1325.               UserEscQuit;
  1326.               Write( ScanMsg );
  1327.             END; { KeyPressed }
  1328.  
  1329.           END;     {WHILE (NOT EOF(Zip))}
  1330.           CLOSE( Zip );
  1331.         END; { IOresult = 0 }
  1332.         GOTOXY( XX, WHEREY );
  1333.         Write( Replicate( #32, LENGTH( ScanMsg ) + 1 ) );
  1334.         GOTOXY( XX, WHEREY );
  1335.       END; { ZipScan }
  1336.  
  1337.     BEGIN { CheckMultSpec }
  1338.       Match12 := File12( DirInfo.Name );
  1339.       MatchTF := Match( Match12, File12( PS ) );
  1340.       IF ( PSaddCount > 0 ) THEN FOR I := 1 TO PSaddCount
  1341.         DO MatchTF := MatchTF OR Match( Match12, File12( PSadd[ I ] ) );
  1342.       IF MatchTF THEN AddFile( FileInfo( DirInfo ) );
  1343.       IF ZipScanTF AND ( POS ( '.ZIP', DirInfo.Name ) > 0 ) THEN ZipScan;
  1344.     END; { CheckMultSpec }
  1345.  
  1346.   BEGIN { GetFiles }
  1347.     ChDir( Index[ CurDirNo ]^.P );
  1348.     FileCount := 0;
  1349.  
  1350.     { add a little on-screen activity to let user know that program is
  1351.       working (and not hung up) while reading (large) directories }
  1352.     Write( 'Reading directory ' );
  1353.     XX := WHEREX;
  1354.     NB := 0;
  1355.     NBT := 0;
  1356.  
  1357.     IF ( PSaddCount = 0 ) AND ( NOT ZipScanTF )
  1358.       THEN FindFirst( PS, AnyFile, DirInfo )
  1359.       ELSE FindFirst( '*.*', AnyFile, DirInfo );
  1360.     WHILE ( DosError = 0 ) DO BEGIN
  1361.       IF ( DirInfo.Attr AND Directory <> Directory ) AND      { Not a Directory }
  1362.          ( DirInfo.Attr AND VolumeID <> VolumeID ) THEN BEGIN { Not a Volume label }
  1363.         IF ChkAttribs THEN BEGIN
  1364.           IF ( PSaddCount = 0 ) AND ( NOT ZipScanTF )
  1365.             THEN AddFile( FileInfo( DirInfo ) ) ELSE CheckMultSpec;
  1366.         END; { IF ChkAttribs }
  1367.       END;   { NOT Directory or Volume }
  1368.  
  1369.       INC( NBT );
  1370.       IF ( ( NBT MOD BT ) = 1 ) THEN BEGIN
  1371.         INC( NB );
  1372.         IF ( NB > 4 ) THEN NB := 1;
  1373.         GOTOXY( XX, WHEREY );
  1374.         Write( Busy[ NB ] );
  1375.       END;
  1376.       UserEscQuit;
  1377.  
  1378.       FindNext( DirInfo );
  1379.     END; { WHILE }
  1380.  
  1381.     IF ( FileCount = 0 ) THEN Index[ CurDirNo ]^.TF := FALSE ELSE BEGIN
  1382.       Index[ CurDirNo ]^.TF := TRUE;
  1383.       ShowFileTF := TRUE;
  1384.       GOTOXY( 1, WHEREY );
  1385.       Write( 'Sorting directory...' );
  1386.       QuickSort( Index, DirTotal + 1, DirTotal + FileCount );
  1387.       IF ZipScanTF THEN
  1388.         FOR LL := ( DirTotal + 1 ) TO ( DirTotal + FileCount ) DO BEGIN
  1389.           L := POS( ChZipMark, Index[ LL ]^.P );
  1390.           IF ( L > 0 )
  1391.             THEN Index[ LL ]^.P := COPY( Index[ LL ]^.P, L + 1, LenInfoStr );
  1392.         END;
  1393.       CurFileNo := 0;
  1394.       INC( NumFiles, FileCount );
  1395.     END;
  1396.     GOTOXY( 1, WHEREY );
  1397.     Write( BlankLine );
  1398.     GOTOXY( 1, WHEREY );
  1399.   END; { GetFiles }
  1400.  
  1401.   PROCEDURE ShowDir( DirNum : WORD );
  1402.   VAR S12 : Str12;
  1403.   BEGIN
  1404.     STR( DirNum : L, S12 );
  1405.     S := PadR( S12 + '. ' + Index[ DirNum ]^.P, 79 );
  1406.     WriteLn( S );
  1407.     IF OutputTF THEN
  1408.        IF OutFlag[ 3 ] THEN WriteLn( FW, Index[ DirNum ]^.P )
  1409.                        ELSE IF OutFlag[ 4 ] THEN WriteLn( FW, S );
  1410.     INC( RowsShown );
  1411.   END; { ShowDir }
  1412.  
  1413.   PROCEDURE ShowFile( FileNo : WORD );
  1414.   BEGIN
  1415.     S := PadR( Index[ DirTotal + FileNo ]^.P, 79 );
  1416.     WriteLn( S );
  1417.     IF OutputTF THEN IF OutFlag[ 5 ] THEN WriteLn( FW, S );
  1418.     INC( RowsShown );
  1419.   END; { ShowFile }
  1420.  
  1421.   PROCEDURE ShowZipFile;
  1422.   VAR I : WORD;
  1423.   BEGIN
  1424.     FOR I := CurFileNo DOWNTO 1 DO
  1425.       IF ( NOT ( Index[ DirTotal + I ]^.P[ 1 ] = ChZipBullet ) ) THEN BEGIN
  1426.         ShowFile( I );
  1427.         EXIT;
  1428.       END;
  1429.   END;
  1430.  
  1431.   PROCEDURE UserInput;
  1432.   VAR S12 : Str12;
  1433.       DoneTF : BOOLEAN;
  1434.       IE : INTEGER;
  1435.       Ch : CHAR;
  1436.   BEGIN
  1437.     IF FinishedTF THEN BEGIN
  1438.       Write( 'End.  ( # [exit to directory] / Any other key to quit ) -> ' );
  1439.     END ELSE BEGIN
  1440.       Write( 'Continue ( Y[es] / N[o] / C[ontinuous] / # [exit to directory] ) -> ' );
  1441.     END;
  1442.     S12 := '';
  1443.     DoneTF := FALSE;
  1444.     REPEAT
  1445.       Ch := UpCase( READKEY );
  1446.       CASE Ch OF
  1447.         #3, #27, 'N' : BEGIN
  1448.                     S12 := '';
  1449.                     UserCancelTF := TRUE;
  1450.                     DoneTF := TRUE;
  1451.                   END;
  1452.         #8 : IF ( LENGTH( S12 ) > 0 ) THEN BEGIN
  1453.                GOTOXY( WHEREX - 1, WHEREY );
  1454.                Write( #32 );
  1455.                GOTOXY( WHEREX - 1, WHEREY );
  1456.                S12 := COPY( S12, 1, LENGTH( S12 ) - 1 );
  1457.              END;
  1458.         #13, #32, 'Y' : DoneTF := TRUE;
  1459.         #48..#57 : BEGIN
  1460.                      S12 := S12 + Ch;
  1461.                      Write( Ch );
  1462.                    END;
  1463.         'C' : BEGIN
  1464.                 AutoYesTF := TRUE;
  1465.                 DoneTF := TRUE;
  1466.               END;
  1467.       END; { CASE Ch }
  1468.     UNTIL DoneTF;
  1469.     GOTOXY( 1, WHEREY );
  1470.     Write( BlankLine );
  1471.     GOTOXY( 1, WHEREY );
  1472.     VAL( S12, ExitDirNum, IE );
  1473.     IF ( IE <> 0 ) THEN ExitDirNum := 0;
  1474.     IF ( ExitDirNum > 0 ) THEN UserCancelTF := TRUE;
  1475.   END; { UserInput }
  1476.  
  1477. BEGIN { ListDirs }
  1478.   CASE ProgNum OF
  1479.     ProgFF : MaxScrnY := MaxRows - 3;
  1480.     ProgLD : MaxScrnY := MaxRows - 2;
  1481.   END; { CASE ProgNum }
  1482.   UserCancelTF := FALSE;
  1483.   NumFiles := 0;
  1484.   GOTOXY( 41, WHEREY - 2 );
  1485.   WriteLn( DirTotal, ' directories.' );
  1486.   IF CountLnsTF THEN FileBanner := Banner + '# of Lines'
  1487.                 ELSE FileBanner := Banner + 'Space Used';
  1488.   IF OutputTF THEN BEGIN
  1489.     ASSIGN( FW, OutputFile );
  1490.     REWRITE( FW );
  1491.     IF OutFlag[ 1 ] THEN WriteLn( FW, 'Command: ', CmdLine );
  1492.     IF OutFlag[ 2 ] THEN WriteLn( FW, DirTotal,
  1493.                     ' directories starting from ', Index[ 1 ]^.P );
  1494.   END;
  1495.   IF ( ProgNum = ProgFF ) THEN BEGIN
  1496.     WriteLn( FileBanner );
  1497.     IF OutputTF THEN IF OutFlag[ 5 ] THEN WriteLn( FW, FileBanner );
  1498.   END;
  1499.   STR( DirTotal, S12 );
  1500.   L := LENGTH( S12 );
  1501.   CurDirNo := 0;
  1502.   RowsShown := 0;
  1503.   ShowFileTF := FALSE;
  1504.   DrvSource := Index[ 1 ]^.P[ 1 ];
  1505.   Clusticity[ 1 ] := ByteClust( ORD( DrvSource ) - 64 );
  1506.   IF ( NOT ( DrvTarget = #0 ) ) THEN BEGIN
  1507.     Clusticity[ 2 ] := ByteClust( ORD( DrvTarget ) - 64 );
  1508.     TargetSize[ 1 ] := DiskFree( ORD( DrvTarget ) - 64 );
  1509.     TargetSize[ 2 ] := DiskSize( ORD( DrvTarget ) - 64 );
  1510.   END;
  1511.   MultClusterTF := FALSE;
  1512.   EnoughSpace := 0;
  1513.  
  1514.   { main REPEAT: heart of directory/file listing routine }
  1515.   REPEAT
  1516.     { this REPEAT: one screenful at a time }
  1517.     REPEAT
  1518.       IF ShowFileTF THEN BEGIN
  1519.         INC( CurFileNo );
  1520.         ShowFile( CurFileNo );
  1521.         IF ( CurFileNo = FileCount ) THEN BEGIN
  1522.           ShowFileTF := FALSE;
  1523.           IF ( CurDirNo = DirTotal ) THEN BREAK;
  1524.         END;
  1525.       END ELSE BEGIN
  1526.         INC( CurDirNo );
  1527.         IF ( ProgNum = ProgFF ) THEN GetFiles ELSE Index[ CurDirNo ]^.TF := TRUE;
  1528.         IF Index[ CurDirNo ]^.TF THEN ShowDir( CurDirNo );
  1529.         IF ( CurDirNo = DirTotal ) AND ( NOT ShowFileTF ) THEN BREAK;
  1530.       END;
  1531.     UNTIL ( RowsShown = MaxScrnY ); { screenful }
  1532.  
  1533.     FinishedTF := ( CurDirNo = DirTotal ) AND ( NOT ShowFileTF );
  1534.     RowsShown := 0;
  1535.     IF ( NOT AutoYesTF ) THEN
  1536.       IF ( NOT FinishedTF ) OR ( NumFiles > 0 ) THEN UserInput;
  1537.     IF UserCancelTF THEN BREAK ELSE IF ( NOT FinishedTF ) THEN
  1538.       IF ( NOT AutoYesTF ) THEN BEGIN
  1539.         Write( PadR( ProgramName + #32 + Version + #32 + Extra, 79 ) );
  1540.         GOTOXY( 41, WHEREY );
  1541.         WriteLn( DirTotal, ' directories.' );
  1542.         IF ( ProgNum = ProgFF ) THEN BEGIN
  1543.           WriteLn( FileBanner );
  1544.           IF ShowFileTF THEN
  1545.             IF ( CurFileNo < FileCount ) THEN BEGIN
  1546.               ShowDir( CurDirNo );
  1547.               IF ( Index[ DirTotal + CurFileNo + 1 ]^.P[ 1 ] = ChZipBullet )
  1548.                 THEN ShowZipFile;
  1549.             END;
  1550.       END; { ( NOT AutoYesTF ) }
  1551.     END;
  1552.   UNTIL FinishedTF; { full listing routine }
  1553.  
  1554.   IF ( ProgNum = ProgFF ) AND ( NOT UserCancelTF ) THEN BEGIN { Summary }
  1555.  
  1556.     IF ( NumFiles = 0 ) THEN BEGIN
  1557.       S := 'No files matching ' + PS;
  1558.       IF ZipScanTF THEN S := S + ' (or in .ZIP)';
  1559.       S := S + ', starting @ ' + Trim( Index[ 1 ]^.P ) + '.';
  1560.       WriteLn( S );
  1561.       IF OutputTF THEN BEGIN
  1562.         IF OutFlag[ 6 ] THEN WriteLn( FW, S );
  1563.         CLOSE( FW );
  1564.       END;
  1565.       EXIT;
  1566.     END;
  1567.  
  1568.     { add space used by directory structure }
  1569.     SpaceTotal[ 2 ] := SpaceTotal[ 1 ] + ( Clusticity[ 1 ] * NoOfDirsInDS );
  1570.     IF NOT ( DrvTarget = #0 ) THEN
  1571.       TargetSpace[ 2 ] := TargetSpace[ 1 ] + ( Clusticity[ 2 ] * NoOfDirsInDS );
  1572.     FOR NL := 1 TO MaxClustChk DO SpaceCluster[ NL, 2 ] :=
  1573.         SpaceCluster[ NL, 1 ] + 1024 * Power( 2, NL ) * NoOfDirsInDS;
  1574.  
  1575.     { determine largest value that will be printed,
  1576.       so we can line up the numbers
  1577.       so it doesn't look like a kitchen sink full of dirty dishes }
  1578.     FOR NL := 0 TO 2 DO
  1579.         L := MAX( L, LENGTH( PrintUsing( SpaceTotal[ NL ] ) ) );
  1580.     FOR NL := 1 TO 2 DO
  1581.         L := MAX( L, LENGTH( PrintUsing( TargetSize[ NL ] ) ) );
  1582.     FOR NL := 1 TO 2 DO
  1583.         L := MAX( L, LENGTH( PrintUsing( TargetSpace[ NL ] ) ) );
  1584.     FOR NL := 1 TO MaxClustChk DO
  1585.         L := MAX( L, LENGTH( PrintUsing( SpaceCluster[ NL, 2 ] ) ) );
  1586.     INC( L ); { one space to left to indent }
  1587.  
  1588.     STR( NumFiles, S12 );
  1589.     S := PadL( PrintUsing( SpaceTotal[ 0 ] ), L ) + ' bytes ';
  1590.     IF CountLnsTF THEN S := S + '(' + PrintUsing( LinesTotal ) + ' lines) ';
  1591.     S := S + 'in ' + S12 + ' files matching ' + PS;
  1592.     IF ( PSaddCount > 0 ) THEN FOR NL := 1 TO PSaddCount DO
  1593.       S := S + ',' + PSadd[ NL ];
  1594.     IF ZipScanTF THEN S := S + ' (or in .ZIP)';
  1595.     S := S + '.';
  1596.     WriteLn( S );
  1597.     IF OutputTF THEN IF OutFlag[ 6 ] THEN WriteLn( FW, S );
  1598.  
  1599.     IF ( EnvVar = '' ) THEN S12 := 'on Drive ' + DrvSource
  1600.                        ELSE S12 := 'in PATH';
  1601.     S := PadL( PrintUsing( SpaceTotal[ 1 ] ), L ) +
  1602.          ' bytes of diskspace used ' + S12 + '. (cluster size: ';
  1603.     IF MultClusterTF THEN S := S + 'varies)'
  1604.                      ELSE S := S + PrintUsing( Clusticity[ 1 ] ) + ')';
  1605.     WriteLn( S );
  1606.     IF OutputTF THEN IF OutFlag[ 7 ] THEN WriteLn( FW, S );
  1607.  
  1608.     IF ( EnvVar = '' ) THEN S12 := 'on Drive ' + DrvSource
  1609.                        ELSE S12 := 'in PATH';
  1610.     S := PadL( PrintUsing( SpaceTotal[ 2 ] ), L ) +
  1611.          ' bytes of diskspace used ' + S12 + '. (incl. directory tree)';
  1612.     WriteLn( S );
  1613.     IF OutputTF THEN IF OutFlag[ 7 ] THEN WriteLn( FW, S );
  1614.  
  1615.     IF ClusterTF THEN FOR NL := 1 TO MaxClustChk DO BEGIN
  1616.       ClusterCluster := 1024 * Power( 2, NL );
  1617.       IF ( NL < 4 ) THEN BEGIN
  1618.         ClusterPart := 64 * Power( 2, NL );
  1619.         S12 := ' MB.';
  1620.       END ELSE BEGIN
  1621.         ClusterPart := Power( 2, ( NL - 4 ) );
  1622.         S12 := ' GB.';
  1623.       END;
  1624.       S := 'Clusters are ' + PrintUsing( ClusterCluster ) + ' bytes (' +
  1625.            PrintUsing( Power( 2, NL ) ) + ' KB) on HD partitions up to ' +
  1626.            PrintUsing( ClusterPart ) + S12;
  1627.       WriteLn( S );
  1628.       IF OutputTF THEN IF OutFlag[ 7 ] THEN WriteLn( FW, S );
  1629.       FOR NM := 1 TO 2 DO BEGIN
  1630.         IF ( NM = 1 ) THEN S12 := 'files only' ELSE S12 := 'plus tree.';
  1631.         S := PadL( PrintUsing( SpaceCluster[ NL, NM ] ), L ) +
  1632.              ' bytes (using cluster size: ' +
  1633.              PrintUsing( ClusterCluster ) + '), ' + S12;
  1634.         IF ( NM = 1 ) THEN S := S + ', ' +
  1635.            WastedSpace( SpaceTotal[ 0 ], SpaceCluster[ NL, NM ] ) +
  1636.            '% wasted.';
  1637.         WriteLn( S );
  1638.         IF OutputTF THEN IF OutFlag[ 7 ] THEN WriteLn( FW, S );
  1639.       END;
  1640.     END;
  1641.  
  1642.     IF NOT ( DrvTarget = #0 ) THEN BEGIN
  1643.       S := PadL( PrintUsing( TargetSize[ 1 ] ), L ) +
  1644.            ' bytes available on Drive ' + DrvTarget + '. (total size: ' +
  1645.            PrintUsing( TargetSize[ 2 ] ) + ')';
  1646.       WriteLn( S );
  1647.       IF OutputTF THEN IF OutFlag[ 7 ] THEN WriteLn( FW, S );
  1648.  
  1649.       S := PadL( PrintUsing( TargetSpace[ 1 ] ), L ) +
  1650.            ' bytes required to copy files to Drive ' + DrvTarget +
  1651.            '. (cluster size: ' + PrintUsing( Clusticity[ 2 ] ) + ')';
  1652.       WriteLn( S );
  1653.       IF OutputTF THEN IF OutFlag[ 7 ] THEN WriteLn( FW, S );
  1654.  
  1655.       S := PadL( PrintUsing( TargetSpace[ 2 ] ), L ) +
  1656.            ' bytes required to copy files to Drive ' + DrvTarget +
  1657.            ', recreating tree.';
  1658.       WriteLn( S );
  1659.       IF OutputTF THEN IF OutFlag[ 7 ] THEN WriteLn( FW, S );
  1660.  
  1661.       IF ( TargetSize[ 1 ] >= TargetSpace[ 1 ] ) THEN INC( EnoughSpace );
  1662.       IF ( TargetSize[ 1 ] >= TargetSpace[ 2 ] ) THEN INC( EnoughSpace );
  1663.       CASE EnoughSpace OF
  1664.         0 : S := 'Insufficient diskspace.';
  1665.         1 : S := 'Sufficient diskspace for files but not to recreate directory tree.';
  1666.         2 : S := 'Sufficient diskspace.';
  1667.       END; { CASE EnoughSpace }
  1668.       WriteLn( S );
  1669.       IF OutputTF THEN IF OutFlag[ 7 ] THEN WriteLn( FW, S );
  1670.     END;   { NOT ( DrvTarget = #0 ) }
  1671.   END;     { Summary ( ProgNum = ProgFF ) }
  1672.  
  1673.   IF OutputTF THEN BEGIN
  1674.     CLOSE( FW );
  1675. (* @@ Scrn
  1676.     ScrPut1( TRUE ); { restore saved screen }
  1677. *)
  1678.     WriteLn( '   (Output file: ' + OutputFile, ')' );
  1679.   END;
  1680.   IF ( ExitDirNum > 0 ) AND ( ExitDirNum <= DirTotal )
  1681.     THEN ChDir( Index[ ExitDirNum ]^.P );
  1682. END; { ListDirs }
  1683.  
  1684. {
  1685. ╔══════════════════════════════════════════════════════════════════════════╗
  1686. ║ InitProg (initialize program)                                            ║
  1687. ║ * saves the current directory                                            ║
  1688. ║ * sets defaults for global variables                                     ║
  1689. ║ * dissects the command line arguments                                    ║
  1690. ║ * determines whether or not a file specification has been passed         ║
  1691. ║ * determines whether date / time passes is valid                         ║
  1692. ║ * resolves ambiguous starting directory from the file specification      ║
  1693. ║ * build lists of directories (if /S passed)                              ║
  1694. ║ * count files that would be touched                                      ║
  1695. ║ * sets CodeDate & CodeTime to simplify later time-stamping               ║
  1696. ╚══════════════════════════════════════════════════════════════════════════╝
  1697. }
  1698.  
  1699. PROCEDURE InitProg;
  1700. VAR P, EV : STRING;
  1701.     I, J : BYTE;
  1702.     StartDir : DirStr;
  1703.     DirCounter : WORD;
  1704.     S12 : Str12;
  1705.     DPM : ARRAY[ 1..12 ] OF BYTE;
  1706.     AnyAttrFlagTF, OutTF   : BOOLEAN;
  1707.     Ch : CHAR;
  1708.  
  1709.   { InitDPM: set days per month according to year }
  1710.   PROCEDURE InitDPM( Year : WORD );
  1711.   BEGIN
  1712.     DPM[ 1 ] := 31;
  1713.     IF ( Year MOD 4 = 0 ) AND ( Year MOD 100 > 0 ) THEN DPM[ 2 ] := 29
  1714.                                                    ELSE DPM[ 2 ] := 28;
  1715.     DPM[ 3 ] := 31;
  1716.     DPM[ 4 ] := 30;
  1717.     DPM[ 5 ] := 31;
  1718.     DPM[ 6 ] := 30;
  1719.     DPM[ 7 ] := 31;
  1720.     DPM[ 8 ] := 31;
  1721.     DPM[ 9 ] := 30;
  1722.     DPM[ 10 ] := 31;
  1723.     DPM[ 11 ] := 30;
  1724.     DPM[ 12 ] := 31;
  1725.   END; { InitDPM }
  1726.  
  1727.   PROCEDURE SetYY; { our most clever of procedures,
  1728.                      why didn't we document it better? }
  1729.   CONST NumRows = 1;
  1730.   VAR I : BYTE;
  1731.   BEGIN
  1732.     FOR I := 1 TO NumRows DO WriteLn;
  1733.     YY := WHEREY - NumRows;
  1734.   END; { SetYY }
  1735.  
  1736.   { SetPS: take only the first parameter that look like a path-string }
  1737.   PROCEDURE SetPS( S : STRING );
  1738.   BEGIN
  1739.     IF ( PS = '' ) THEN PS := S ELSE BEGIN
  1740.       INC( PSaddCount );
  1741.       PSadd[ PSaddCount ] := S;
  1742.     END;
  1743.   END; { SetPS }
  1744.  
  1745.   PROCEDURE ChkFlag( S : STRING ); { / always stripped from S on entry }
  1746.   VAR Ch      : CHAR;
  1747.       N       : WORD;
  1748.       IE      : INTEGER;
  1749.       SaveStr : STRING;
  1750.       NV      : BYTE;
  1751.  
  1752.     { Invalid: If we detect an invalid "/" parameter, get even.
  1753.                Complain to the user 'bout it. }
  1754.     PROCEDURE Invalid( S12 : Str12 );
  1755.     BEGIN
  1756.       Error( 'Invalid ' + S12 + ': ' + SaveStr );
  1757.     END; { Invalid }
  1758.  
  1759.     { BreakStr: This function looks for a numeric value in string S
  1760.                 that's in front of the delimiter character Ch.
  1761.                 The existence of this delimiter must be verified prior
  1762.                 to calling BreakStr (no error trap here, Jacq!).
  1763.                 The numeric value is placed in N and
  1764.                 S is returned as the substring following our delimiter.
  1765.                 The return value IE is 0 if the VAL function successfully
  1766.                 returned a numeric value (if not 0, N is bogus, dude!).
  1767.                 This is used to interpret date & time strings such as
  1768.                 1-1-80 and 23:59:01. }
  1769.     FUNCTION BreakStr( VAR S : STRING; Delim : CHAR; VAR N : WORD ) : INTEGER;
  1770.     VAR IE : INTEGER;
  1771.         I : BYTE;
  1772.     BEGIN
  1773.       I := POS( Delim, S );
  1774.       VAL( COPY( S, 1, I - 1 ), N, IE );
  1775.       S := COPY( S, I + 1, 255 );
  1776.       BreakStr := IE;
  1777.     END; { BreakStr }
  1778.  
  1779.     FUNCTION CountDelim( S : STRING;  Delim : CHAR ) : BYTE;
  1780.     VAR I, J : BYTE;
  1781.     BEGIN
  1782.       J := 0;
  1783.       FOR I := 1 TO LENGTH( S ) DO IF ( S[ I ] = Delim ) THEN INC( J );
  1784.       CountDelim := J;
  1785.     END; { CountDelim }
  1786.  
  1787.     PROCEDURE CheckDate;
  1788.     BEGIN
  1789.       IF ( ArgDT.Month < 1 ) OR ( ArgDT.Month > 12 ) THEN Invalid( 'Date' );
  1790.       InitDPM( ArgDT.Year );
  1791.       IF ( ArgDT.Day < 1 ) OR ( ArgDT.Day > DPM[ ArgDT.Month ] )
  1792.         THEN Invalid( 'Date' );
  1793.     END; { CheckDate }
  1794.  
  1795.     PROCEDURE CheckTime;
  1796.     BEGIN
  1797.       IF ( ArgDT.Hour < 0 ) OR ( ArgDT.Hour > 23 ) OR
  1798.          ( ArgDT.Min < 0 ) OR ( ArgDT.Min > 59 ) OR
  1799.          ( ArgDT.Sec < 0 ) OR ( ArgDT.Sec > 59 ) THEN Invalid( 'Time' );
  1800.     END; { CheckTime }
  1801.  
  1802.   BEGIN  { ChkFlag }
  1803.  
  1804.     { chicken way of getting /SYS without modifying rest of procedure }
  1805.     IF ( COPY( S, 1, 3 ) = 'SYS' ) THEN BEGIN 
  1806.       S := AttrSys + COPY( S, 4, 1 );
  1807.     END;
  1808.  
  1809.     Ch := S[ 1 ];
  1810.     S := COPY( S, 2, 255 );
  1811.     IF ( Ch = '?' ) THEN Help;
  1812.     IF ( Ch = 'S' ) THEN IF ( S = '-' ) THEN SubDirTF := FALSE
  1813.                                         ELSE SubDirTF := TRUE;
  1814.     IF ( Ch = 'Y' ) THEN AutoYesTF := TRUE;
  1815.     IF ( Ch = '1' ) THEN ForcePromptTF := TRUE;
  1816.  
  1817.     IF ( ProgramNum IN [ ProgFF, ProgFA ] ) THEN BEGIN
  1818.       FOR IE := 1 TO 4 DO IF ( Ch = AttrChar[ IE ] ) THEN BEGIN
  1819.         IF ( Ch = 'S' ) THEN IF COPY( S, 1, 2 ) = 'YS'
  1820.           THEN S := COPY( S, 3, 1 ) ELSE BREAK; { skip out of FOR }
  1821.         IF ( S = '+' ) OR
  1822.            ( ( ProgramNum = ProgFF ) AND ( S = '' ) )
  1823.           THEN AttrFlag[ IE ] := 1
  1824.           ELSE IF ( S = '-' ) THEN AttrFlag[ IE ] := -1;
  1825.       END; { FOR IE : attributes R A S H }
  1826.       IF ( ProgramNum = ProgFF ) THEN BEGIN
  1827.         IF ( Ch = 'E' ) AND ( LENGTH( S ) > 0 ) THEN BEGIN
  1828.           IF ( S[ 1 ] = ':' ) THEN S := COPY( S, 2, 255 );
  1829.           EnvVar := GetEnv( S );
  1830.           IF ( EnvVar = '' )
  1831.             THEN Error( 'Environment variable ' + S + ' not found.' );
  1832.         END; { 'E' }
  1833.         IF ( Ch = 'F' ) AND ( LENGTH( S ) > 0 ) THEN BEGIN
  1834.           IE := POS( ':', S );
  1835.           IF ( IE > 0 ) THEN IF ( LENGTH( S ) > IE )
  1836.             THEN DrvTarget := S[ IE + 1 ];
  1837.         END; { 'F' }
  1838.         IF ( Ch = 'L' ) THEN CountLnsTF  := TRUE;
  1839.         IF ( Ch = 'C' ) THEN ClusterTF := TRUE;
  1840.         IF ( Ch = 'Z' ) THEN ZipScanTF := TRUE;
  1841.       END; { ( ProgramNum = ProgFF ) }
  1842.     END;   { ( ProgramNum IN [ ProgFF, ProgFA ] ) }
  1843.  
  1844.     IF ( ProgramNum = ProgFD ) THEN BEGIN
  1845.       IF ( Ch = 'D' ) THEN BEGIN
  1846.         IF ( LENGTH( S ) = 0 ) THEN CodeDate := CmdValFlagOnly ELSE BEGIN
  1847.           CodeDate := CmdValArg;  { flag & New Date }
  1848.           SaveStr := S;
  1849.           IF ( CountDelim( S, '-' ) < 2 ) THEN
  1850.             Invalid( 'Date' ); { mm-dd-yy req'd }
  1851.           IE := BreakStr( S, '-', N );
  1852.           IF ( IE = 0 ) THEN BEGIN
  1853.             ArgDT.Month := N;
  1854.             IE := BreakStr( S, '-', N );
  1855.             IF ( IE = 0 ) THEN BEGIN
  1856.               ArgDT.Day := N;
  1857.               IF ( LENGTH( S ) = 2 ) THEN S := '19' + S;
  1858.               VAL( S, ArgDT.Year, IE );
  1859.               IF ( IE <> 0 ) THEN Invalid( 'Date' );  { can't interpret year }
  1860.             END ELSE Invalid( 'Date' );               { can't interpret day # }
  1861.           END ELSE Invalid( 'Date' );                 { can't interpret month # }
  1862.           CheckDate;
  1863.         END;
  1864.       END; { ( Ch = 'D' ) }
  1865.       IF ( Ch = 'T' ) THEN BEGIN
  1866.         IF ( LENGTH( S ) = 0 ) THEN CodeTime := CmdValFlagOnly ELSE BEGIN
  1867.           CodeTime := CmdValArg;  { flag & New Time }
  1868.           SaveStr := S;
  1869.           WHILE ( CountDelim( S, ':' ) < 2 ) DO BEGIN { will accept 0, 1, or 2 colons in time }
  1870.             S := S + ':00';
  1871.           END;
  1872.           IE := BreakStr( S, ':', N );
  1873.           IF ( IE = 0 ) THEN BEGIN
  1874.             ArgDT.Hour := N;
  1875.             IE := BreakStr( S, ':', N );
  1876.             IF ( IE = 0 ) THEN BEGIN
  1877.               ArgDT.Min := N;
  1878.               VAL( S, ArgDT.Sec, IE );
  1879.               IF ( IE <> 0 ) THEN Invalid( 'Time' );  { can't interpret secs }
  1880.             END ELSE Invalid( 'Time' );               { can't interpret mins }
  1881.           END ELSE Invalid( 'Time' );                 { can't interpret hour }
  1882.           CheckTime;
  1883.         END;
  1884.       END; { ( Ch = 'T' ) }
  1885.     END;   { ( ProgNum = ProgFD ) }
  1886.  
  1887.     IF ( ProgramNum IN [ ProgFF, ProgLD ] ) THEN BEGIN
  1888.       IF ( Ch = 'W' ) AND ( LENGTH( S ) > 0 ) THEN BEGIN
  1889.         CASE S[ 1 ] OF
  1890.           ':' : BEGIN
  1891.                   S := COPY( S, 2, 255 );
  1892.                   IF ( LENGTH( S ) > 0 ) THEN BEGIN
  1893.                     IF ( POS( '\', S ) = 0 )
  1894.                       THEN OutputFile := FullName( CD, S )
  1895.                       ELSE OutputFile := S;
  1896.                     OutputTF := TRUE;
  1897.                   END;
  1898.                 END; { /W: }
  1899.           'O' : OutOverAutoTF := TRUE;
  1900.         END; { CASE S[ 1 ] }
  1901.         IF ( NOT ( S[ 1 ] = ':' ) ) THEN BEGIN
  1902.           FOR N := 1 TO LENGTH( S ) DO BEGIN
  1903.             VAL( S[ N ], NV, IE );
  1904.             IF ( ( NV > 0 ) AND ( NV <= MaxOutOpts ) ) THEN BEGIN
  1905.               OutFlag[ NV ] := TRUE;
  1906.               OutTF := TRUE;
  1907.             END;   { ( NV > 0 ) AND ( NV <= MaxOutOpts ) }
  1908.           END;     { FOR N }
  1909.         END;       { NOT ( S[ 1 ] = ':' ) }
  1910.       END;   { /W }
  1911.     END;     { ( ProgramNum IN [ ProgFF, ProgLD ] ) }
  1912.  
  1913.   END;     { ChkFlag }
  1914.  
  1915.   PROCEDURE CheckFlags( S : STRING ); { S always begins with / on entry }
  1916.   VAR I : BYTE;
  1917.   BEGIN
  1918.     REPEAT
  1919.       S := COPY( S, 2, 255 );
  1920.       I := POS( '/', S );
  1921.       IF ( I = 0 ) THEN ChkFlag( S ) ELSE BEGIN
  1922.         ChkFlag( COPY( S, 1, I - 1 ) );
  1923.         S := COPY( S, I, 255 );
  1924.       END;
  1925.     UNTIL ( POS( '/', S ) = 0 );
  1926.   END; { CheckFlags }
  1927.  
  1928.   PROCEDURE AdjustCodes;
  1929.   BEGIN
  1930.     { ( similar true for CodeTime )
  1931.       As set in ChkFlag
  1932.       CodeDate : CmdValNone     : /D not spec'd
  1933.                  CmdValArg      : /D with specified Date
  1934.                  CmdValFlagOnly : /D only
  1935.  
  1936.       To be used in ProcessFiles ( for FD routine only ):
  1937.       CodeDate : ValFile : Retain file date
  1938.                  ValSys  : Set to system date
  1939.                  ValArg  : Set to specified date
  1940.     }
  1941.     IF ( CodeDate = CmdValNone ) THEN BEGIN
  1942.       IF ( CodeTime = CmdValNone ) THEN BEGIN
  1943.         CodeDate := ValSys;
  1944.         CodeTime := ValSys;
  1945.       END ELSE BEGIN
  1946.         CodeDate := ValFile;
  1947.         IF ( CodeTime = CmdValArg ) THEN CodeTime := ValArg
  1948.                                     ELSE CodeTime := ValSys;
  1949.       END;
  1950.     END ELSE BEGIN
  1951.       IF ( CodeDate = CmdValArg ) THEN CodeDate := ValArg
  1952.                                   ELSE CodeDate := ValSys;
  1953.       CASE CodeTime OF
  1954.         CmdValNone     : CodeTime := ValFile;
  1955.         CmdValFlagOnly : CodeTime := ValSys;
  1956.         CmdValArg      : CodeTime := ValArg;
  1957.       END; { CASE CodeTime }
  1958.     END;
  1959.  
  1960.     CASE CodeDate OF
  1961.       ValFile : UserDateStr := '(retain file date)';
  1962.       ValSys  : UserDateStr := 'date set to system clock';
  1963.       ValArg  : UserDateStr := 'date set to ' +
  1964.                 DateTimeStr( ArgDT.Month, ArgDT.Day, ArgDT.Year );
  1965.     END; { CASE CodeDate }
  1966.     CASE CodeTime OF
  1967.       ValFile : UserTimeStr := '(retain file time)';
  1968.       ValSys  : UserTimeStr := 'time set to system clock';
  1969.       ValArg  : UserTimeStr := 'time set to ' +
  1970.                 DateTimeStr( ArgDT.Hour, ArgDT.Min, ArgDT.Sec );
  1971.     END; { CASE CodeDate }
  1972.   END; { AdjustCodes }
  1973.  
  1974.   PROCEDURE WhichProgram;
  1975.   VAR PS : PathStr;
  1976.       D : DirStr;
  1977.       E : ExtStr;
  1978.       I, J : BYTE;
  1979.   BEGIN
  1980.     ProgramName := GetEnv( 'FADS' );
  1981.     IF ( ProgramName = '' ) THEN BEGIN
  1982.       PS := ParamStr( 0 );  { name of executable }
  1983.       FSplit( PS, D, ProgramName, E );
  1984.     END;
  1985.     ProgramName := UpStr( ProgramName );
  1986.     ProgramNum := 0;
  1987.     FOR I := 1 TO 5 DO FOR J := 1 TO MaxNames DO
  1988.       IF ( ProgramName = ProgNameArray[ I, J ] ) THEN ProgramNum := I;
  1989.     IF ( ProgramNum = ProgLC ) THEN BEGIN
  1990.       CountLnsTF := TRUE;
  1991.       SubDirTF   := FALSE;
  1992.       ProgramNum := ProgFF; { easier just to leach off FF routine }
  1993.     END;
  1994.     IF ( ProgramNum = 0 ) THEN BEGIN
  1995.       WriteLn( 'Cannot identify program.' );
  1996.       ChameleonHelp;
  1997.     END;
  1998.   END; { WhichProgram }
  1999.  
  2000. BEGIN  { InitProg }
  2001.   GetDir( 0, CD );   { Save current directory }
  2002.   PS := '';          { Set our wonderful path specifier to a dull null }
  2003.   SubDirTF := TRUE;  { if FF & LD, we search subdirs by default }
  2004.   FOR I := 0 TO 2 DO SpaceTotal[ I ] := 0;
  2005.   FOR I := 1 TO 2 DO TargetSize[ I ] := 0;
  2006.   FOR I := 1 TO 2 DO Clusticity[ I ] := 0;
  2007.   FOR I := 1 TO 2 DO TargetSpace[ I ] := 0;
  2008.   FOR I := 1 TO MaxClustChk DO SpaceCluster[ I, 1 ] := 0;
  2009.   FOR I := 1 TO MaxOutOpts DO OutFlag[ I ] := FALSE;
  2010.   AutoYesTF := FALSE;
  2011.   ForcePromptTF := FALSE;
  2012.   CodeDate    := CmdValNone;    { No /D flag }
  2013.   ArgDT.Year  := 0;
  2014.   ArgDT.Month := 0;
  2015.   ArgDT.Day   := 0;
  2016.   CodeTime    := CmdValNone;    { No /T flag }
  2017.   ArgDT.Hour  := 0;
  2018.   ArgDT.Min   := 0;
  2019.   ArgDT.Sec   := 0;
  2020.   EnvVar      := '';
  2021.   DrvTarget   := #0;
  2022.   ExitDirNum  := 0;
  2023.   CountLnsTF  := FALSE;
  2024.   LinesTotal  := 0;
  2025.   OutputFile  := '';
  2026.   OutputTF    := FALSE;
  2027.   OutOverAutoTF := FALSE;
  2028.   BlankLine   := Replicate( #32, 79 );
  2029.   ClusterTF   := FALSE;
  2030.   PSaddCount  := 0;
  2031.   CmdLine     := ParamStr( 0 );
  2032.   ZipScanTF   := FALSE;
  2033.   OutTF       := FALSE;
  2034.  
  2035.   WhichProgram; { If we can't figure it out here, let 'em weep!
  2036.                   We're exiting to DOS after a message }
  2037.  
  2038.   WriteLn( ProgramName, #32, Version, #32, Extra ); { the sign-on }
  2039.  
  2040. (* @@ Scrn
  2041.   { save current screen }
  2042.   ScrGet1;
  2043. *)
  2044.  
  2045.   { First, decipher command line parameters }
  2046.   IF ( ParamCount = 0 ) THEN BEGIN
  2047.     IF ( ProgramNum IN [ ProgFD, ProgFA ] ) THEN Help ELSE PS := CD;
  2048.   END ELSE BEGIN  { Parameters passed }
  2049.     IF ( ProgramNum IN [ ProgFD, ProgFA ] )
  2050.       THEN SubDirTF := FALSE;  { no subdirectory search for Touch unless /S }
  2051.     FOR I := 1 TO ParamCount DO BEGIN
  2052.       CmdLine := CmdLine + #32 + ParamStr( I );
  2053.       P := UpStr( ParamStr( I ) );
  2054.       J := POS( '/', P );
  2055.       IF ( J = 0 ) THEN SetPS( P ) ELSE BEGIN
  2056.         CheckFlags( COPY( P, J, 255 ) );
  2057.         P := COPY( P, 1, J - 1 );
  2058.         IF NOT ( P = '' ) THEN SetPS( P );
  2059.       END;
  2060.     END; { FOR I }
  2061.     IF ( PS = '' ) THEN CASE ProgramNum OF
  2062.       ProgFF : PS := '*.*';
  2063.       ProgLD : PS := CD;
  2064.     END; { CASE ProgramNum }
  2065.   END;   { ( ParamCount > 0 ) }
  2066.  
  2067.   { Fix OutFlags - whether or not we use 'em }
  2068.   IF ( NOT OutTF ) THEN
  2069.      FOR I := 1 TO MaxOutOpts DO OutFlag[ I ] := TRUE;
  2070.   IF OutFlag[ 4 ] THEN OutFlag[ 3 ] := FALSE;
  2071.  
  2072.   { If program is set to change file attributes AND no attributes are spec'd }
  2073.   IF ( ProgramNum IN [ ProgFA ] ) THEN BEGIN
  2074.     AnyAttrFlagTF := FALSE;
  2075.     FOR I := 1 TO 4 DO IF ( AttrFlag[ I ] <> 0 ) THEN AnyAttrFlagTF := TRUE;
  2076.     IF ( NOT AnyAttrFlagTF ) THEN Help;
  2077.   END;
  2078.  
  2079.   { If we don't have a pathspec (and no default), give the user Help }
  2080.   IF ( PS = '' ) THEN Help;
  2081.  
  2082.   { If an output file was specified, prompt to overwrite an existing one }
  2083.   IF OutputTF THEN BEGIN
  2084.     IF ( FSearch( OutputFile, '' ) = '' ) THEN Ch := 'Y' ELSE BEGIN
  2085.       IF OutOverAutoTF THEN Ch := 'Y' ELSE BEGIN
  2086.         Write( 'Overwrite existing file ', OutputFile, ' (Y/N) -> ' );
  2087.         REPEAT
  2088.           Ch := UpCase( READKEY );
  2089.         UNTIL ( Ch IN [ 'Y', 'N', #27 ] );
  2090.         GOTOXY( 1, WHEREY );
  2091.         Write( BlankLine );
  2092.         GOTOXY( 1, WHEREY );
  2093.       END;
  2094.     END;
  2095.     IF ( Ch = 'Y' )
  2096.       THEN AutoYesTF := TRUE { Assume user want no prompts if Output file }
  2097.       ELSE OutputTF := FALSE;
  2098.   END; { OutputTF }
  2099.  
  2100.   { Determine starting directory }
  2101.   { Using GetDir will turn strings such as C:\DOCS\..\DOCS into a nice clean
  2102.     simple C:\DOCS. }
  2103.   DirTotal := 0; { If we don't set this here,
  2104.                    we might as well go pogo sticking at the beach. }
  2105.   {$I-}
  2106.   ChDir( PS ); { 1st, attempt to log to directory named PS }
  2107.   {$I+}
  2108.   IF ( IOresult = 0 ) THEN BEGIN
  2109.     StartDir := PS;
  2110.     PS := '*.*';
  2111.     GetDir( 0, StartDir );  { set StartDir to standard directory string }
  2112.   END ELSE BEGIN
  2113.     I := LastPos( '\', PS );
  2114.     IF ( I = 0 ) THEN BEGIN
  2115.        I := POS( ':', PS );
  2116.       IF ( I = 0 ) THEN StartDir := CD ELSE BEGIN { only drive specified, no directory }
  2117.         StartDir := COPY( PS, 1, I );
  2118.         PS := COPY( PS, I + 1, 79 );
  2119.         {$I-}
  2120.         ChDir( StartDir );     { change to drive }
  2121.         {$I+}
  2122.         IF NOT ( IOresult = 0 ) THEN Error( 'Invalid drive specified ' + StartDir );
  2123.         GetDir( 0, StartDir ); { make drive's CD our StartDir }
  2124.       END;
  2125.     END ELSE BEGIN  { a directory & filespec have been specified }
  2126.       StartDir := COPY( PS, 1, I );
  2127.       IF ( LENGTH( StartDir ) > 3 ) THEN IF ( StartDir[ I - 1 ] <> ':' )
  2128.         THEN StartDir := COPY( StartDir, 1, I - 1 );
  2129.       PS := COPY( PS, I + 1, 79 );
  2130.       {$I-}
  2131.       ChDir( StartDir );     { change to starting directory }
  2132.       {$I+}
  2133.       IF NOT ( IOresult = 0 ) THEN Error( 'Invalid directory specified ' + StartDir );
  2134.       GetDir( 0, StartDir );  { set StartDir to standard directory string }
  2135.     END;
  2136.   END;
  2137.   AddDirToList( StartDir, FALSE );
  2138.  
  2139.   { Determine screen row for status info }
  2140.   SetYY;
  2141.  
  2142.   { Build list of directories if /S }
  2143.   DirCounter := 0;
  2144.   IF ( EnvVar = '' ) THEN BEGIN
  2145.     IF SubDirTF THEN REPEAT
  2146.       INC( DirCounter );
  2147.       GetDirList( Index[ DirCounter ]^.P );
  2148.     UNTIL ( DirCounter = DirTotal );
  2149.   END ELSE BEGIN
  2150.     DirTotal := 0;
  2151.     EV := UpStr( EnvVar );
  2152.     WHILE ( LENGTH( EV ) > 0 ) DO BEGIN
  2153.       I := POS( ';', EV );
  2154.       IF ( I = 0 ) THEN BEGIN
  2155.         AddDirToList( EV, TRUE );
  2156.         EV := '';
  2157.       END ELSE BEGIN
  2158.         P := COPY( EV, 1, I - 1 );
  2159.         EV := COPY( EV, I + 1, 255 );
  2160.         IF NOT ( P = '' ) THEN AddDirToList( P, TRUE );
  2161.       END;
  2162.     END;
  2163.   END;
  2164.   GOTOXY( 1, YY );
  2165.   STR( DirTotal, S12 );
  2166.   Write( Replicate( #32, LENGTH( S12 ) + 19 ) );
  2167.   FileTotal := DirTotal; { FF adds to end of DirTotal }
  2168.  
  2169.   IF ( ProgramNum IN [ ProgFD, ProgFA ] ) THEN BEGIN
  2170.     { Count # of files that would be touched }
  2171.     ProcessFiles( FALSE ); { count files only - Touch only }
  2172.  
  2173.     { Examine CodeDate & CodeTime set in ChkFlag
  2174.       and modify to values more easily used in ProcessFiles - Touch only }
  2175.       IF ( ProgramNum = ProgFD ) THEN AdjustCodes;
  2176.   END ELSE BEGIN
  2177.     WriteLn;
  2178.     QuickSort( Index, 1, DirTotal );
  2179.   END;
  2180. END;
  2181.  
  2182. {
  2183. ╔══════════════════════════════════════════════════════════════════════════╗
  2184. ║ ExitProg (exit program)                                                  ║
  2185. ║ * disposes of pointers to directory names that were stored on the heap   ║
  2186. ║   (be a good little programmer and clean up after yourself)              ║
  2187. ╚══════════════════════════════════════════════════════════════════════════╝
  2188. }
  2189.  
  2190. PROCEDURE ExitProg;
  2191. VAR I : WORD;
  2192. BEGIN
  2193.   FOR I := FileTotal DOWNTO 1 DO DISPOSE( Index[ I ] );
  2194.   IF ( ExitDirNum = 0 ) THEN ChDir( CD );
  2195. END;
  2196.  
  2197. BEGIN { MAIN }
  2198.   InitProg;
  2199.   IF ( ProgramNum IN [ ProgFD ] ) THEN ModifyFileTime;
  2200.   IF ( ProgramNum IN [ ProgFA ] ) THEN ModifyFileAttr;
  2201.   IF ( ProgramNum IN [ ProgLD, ProgFF ] ) THEN ListDirs( ProgramNum );
  2202.   ExitProg;
  2203. END.
  2204.